*
* $Id: redata.F,v 1.1.1.1 1996/03/22 16:42:47 mclareni Exp $
*
* $Log: redata.F,v $
* Revision 1.1.1.1  1996/03/22 16:42:47  mclareni
* Phtools
*
*
      SUBROUTINE REDATA
C-- CALLED FROM -  MAIN PROGRAM
C--  PURPOSE -   READS ALL DATA CARDS
C                CALCULATES CERTAIN CONSTANTS IN COMMON
C                INITIALIZES CERTAIN VARIABLES
      COMMON / / NDIMEN,BINS(100)
      COMMON/UTIL/PLACE(150),WEIGHT(150),NP,TECM,AMASS(18),PCM(5,18),WT
     +/BEAM  / PRM       ,TARGM    ,PBM      ,ETA      ,GAM      ,DPBM
     +/CONTRL/ NEVTOT    ,TLIMIT   ,TLIM2    ,NDUMP    ,IEVENT
     +        ,DAT1      ,DAT2     ,IPAGE
     +/HISTR / NHIST     ,NGRP     ,NHDIM    ,LTITLE   ,LOCP(150)
     +/TAPES / NTPNCH   ,NTPBIN   ,KONSOL
     +/REDAT / ICRD      ,IDRAPO    ,NGAFF     ,BIGAFF
     +/FDUMP/ FDP(50)
      EQUIVALENCE (NRAN,BINS(1))
C         THE FOLLOWING TWO STATEMENTS SERVE TO STORE THE DATE AND
C         THE FOWL VERSION NUMBER IN THE TWO WORDS DAT1 AND DAT2
#if defined(CERNLIB_CDC)
      DATA DAT2/1H /
      CALL DATIMH(DAT1,DUMMY)
#endif
#if !defined(CERNLIB_CDC)
      CALL DATIMH(FDP(1),FDP(10))
      CALL CHMOVE(FDP,1,DAT1,1,4)
      CALL CHMOVE(FDP,5,DAT2,1,4)
#endif
      BIGAFF  = 0.
      ICRD = 0
      CALL UZERO(FDP,1,50)
      CALL UZERO(PLACE,1,NHDIM)
      CALL UZERO(BINS,1,NDIMEN-2)
      DO  50  I= 1, NHDIM
      WEIGHT(I) = 1.0
   50 CONTINUE
C--
C--       READ FIRST DATA CARD
      READ 5000, NEVTOT, TLIMIT, TLIM2, NDUMP
      ICRD = ICRD + 1
      IF(NEVTOT.LE.0) NEVTOT = 1
      IF(TLIM2.LE.0.) TLIM2 = TLIMIT + 10.
      IF(NDUMP.LE.0) NDUMP=1
C--
C--       READ #BEAM# CARD
      READ 5001,PRM,TARGM,PBM,DPBM
      ICRD = ICRD + 1
      E     = SQRT(PBM**2 + PRM**2)
      ECMS = TARGM**2+PRM**2 + 2.0*TARGM* E
      IF(ECMS.LE.0.) GOTO 4000
C--
C--       OUTGOING PARTICLES CARD
      READ 5002,NP,(AMASS(I), I=1,NP)
      ICRD = ICRD + 1
      IF(NP.LT.2) GOTO 4000
      IF(NP.GT.18) GOTO 4000
      IF(NP.GT.7) ICRD = ICRD + 1
      IF(NP.GT.15) ICRD = ICRD + 1
      NRAN = 3*NP - 4
      TECM = SQRT(ECMS)
      DTECM = 0.0
      IF(E) 53,53,52
   52 DTECM = TARGM*PBM*DPBM / (E*TECM)
   53 CONTINUE
C--
C--       PRINT HEADING FOR FIRST PAGE -- PRINTOUT OF INPUT DATA
      WRITE(6,5003)NEVTOT,TLIMIT
      WRITE(6,5004)PRM,TARGM,PBM,DPBM,TECM,DTECM
      WRITE(6,5005)NP,(I,AMASS(I),I=1,NP)
      WRITE(6,5006)
C--
C--       READ REMAINING CARDS  -- HISTOGRAM CARDS,RAN CARDS,ADD CARDS
      CALL REDAT2
      IF(BIGAFF.GT.1.0) GOTO 4000
      WRITE(6,5019)ICRD,NGAFF
      IF(NGAFF.GT.0) WRITE(6,5020)
      CALL TIMEX(TIME)
      TIME = TIME/60.
      WRITE(6,5012)TIME
      IF(NHIST.LT.20) IPAGE = 1
      RETURN
 4000 CONTINUE
      WRITE(6,4001)ICRD
 4001 FORMAT('0***** ERROR ON DATA CARD NO.',I4)
      STOP
 5000 FORMAT(I10,2F10.0,I10)
 5001 FORMAT(4F10.0)
 5002 FORMAT(I10,(7F10.0))
 5003 FORMAT('0',28X,'REQUESTED TO GENERATE',I10,' EVENTS OR STOP ',
     +'AFTER',F10.2,' MINUTES')
 5004 FORMAT('0',16X,'BEAM MASS',11X,'TARGET MASS',10X,'BEAM MOMENTUM',
     +' AND SPREAD',11X,'CMS ENERGY AND SPREAD'/F25.5,F20.5,
     + 2(F20.5,F15.5))
 5005 FORMAT('0THE MASSES OF THE',I3,' OUTGOING PARTICLES ARE',I10,
     + F12.6/(44X,I10,F12.6))
 5006 FORMAT('0THE FOLLOWING OUTPUT IS REQUESTED',/'0    PLACE  LOLIM'
     +,5X,'UPLIM',5X,'INTVL  SPACE',15('.'),'TITLE',60('.'))
#if defined(CERNLIB_CDC)
 5012 FORMAT(91X,' ELAPSED TIME IS NOW  ',F8.3,'MINUTES.'/,'1')
 5019 FORMAT(91X,I4,' DATA CARDS READ, WITH ',I3,' ERRORS')
 5020 FORMAT(82X,'*',35X,10('*')/82X,'***'/74X,13('*'),9X,'EXECUTION'
     + ,' TIME IS LIMITED TO ONE MINUTE',/82X,'***'/82X,'*')
#endif
#if !defined(CERNLIB_CDC)
 5012 FORMAT(71X,' ELAPSED TIME IS NOW  ',F8.3,'MINUTES'/,'1')
 5019 FORMAT(71X,I4,' DATA CARDS READ, WITH ',I3,' ERRORS')
 5020 FORMAT(62X,'*',35X,10('*')/62X,'***'/54X,13('*'),9X,'EXECUTION',
     + ' TIME IS LIMITED TO ONE MINUTE',/62X,'***'/62X,'*')
#endif
      END
