| 1 | SUBROUTINE START | 
|---|
| 2 |  | 
|---|
| 3 | C----------------------------------------------------------------------- | 
|---|
| 4 | C  START | 
|---|
| 5 | C | 
|---|
| 6 | C  PERFORMS INITIALISATIONS AND CHECKS AT THE BEGINNING OF RUN. | 
|---|
| 7 | C  CALLS DATAC TO READ IN DATA CARDS. | 
|---|
| 8 | C  CHECKS AND INITIALIZES SELECTED HADRONIC INTERACTION MODEL. | 
|---|
| 9 | C  THIS SUBROUTINE IS CALLED FROM MAIN | 
|---|
| 10 | C | 
|---|
| 11 | C  REDESIGN: J. KNAPP   IK1  FZK KARLSRUHE | 
|---|
| 12 | C----------------------------------------------------------------------- | 
|---|
| 13 |  | 
|---|
| 14 | IMPLICIT NONE | 
|---|
| 15 | *KEEP,AIR. | 
|---|
| 16 | COMMON /AIR/     COMPOS,PROBTA,AVERAW,AVOGAD | 
|---|
| 17 | DOUBLE PRECISION COMPOS(3),PROBTA(3),AVERAW,AVOGAD | 
|---|
| 18 | *KEEP,ANNI. | 
|---|
| 19 | COMMON /ANNI/    CAN,CANN | 
|---|
| 20 | DOUBLE PRECISION CAN(50),CANN(50) | 
|---|
| 21 | *KEEP,ATMOS. | 
|---|
| 22 | COMMON /ATMOS/   AATM,BATM,CATM,DATM | 
|---|
| 23 | DOUBLE PRECISION AATM(5),BATM(5),CATM(5),DATM(5) | 
|---|
| 24 | *KEEP,ATMOS2. | 
|---|
| 25 | COMMON /ATMOS2/  HLAY,THICKL | 
|---|
| 26 | DOUBLE PRECISION HLAY(5),THICKL(5) | 
|---|
| 27 | *KEEP,BUFFS. | 
|---|
| 28 | COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH | 
|---|
| 29 | INTEGER          MAXBUF,MAXLEN | 
|---|
| 30 | PARAMETER        (MAXBUF=39*7) | 
|---|
| 31 | PARAMETER        (MAXLEN=12) | 
|---|
| 32 | REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF), | 
|---|
| 33 | *                 RUNE(MAXBUF),DATAB(MAXBUF) | 
|---|
| 34 | INTEGER          LH | 
|---|
| 35 | CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE | 
|---|
| 36 | EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE) | 
|---|
| 37 | EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE) | 
|---|
| 38 | *KEEP,CONST. | 
|---|
| 39 | COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER | 
|---|
| 40 | DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER | 
|---|
| 41 | *KEEP,DPMFLG. | 
|---|
| 42 | COMMON /DPMFLG/  NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM | 
|---|
| 43 | INTEGER          NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM | 
|---|
| 44 | *KEEP,EDECAY. | 
|---|
| 45 | COMMON /EDECAY/  CETA | 
|---|
| 46 | DOUBLE PRECISION CETA(5) | 
|---|
| 47 | *KEEP,ELABCT. | 
|---|
| 48 | COMMON /ELABCT/  ELCUT | 
|---|
| 49 | DOUBLE PRECISION ELCUT(4) | 
|---|
| 50 | *KEEP,ETHMAP. | 
|---|
| 51 | COMMON /ETHMAP/  ECTMAP,ELEFT | 
|---|
| 52 | DOUBLE PRECISION ECTMAP,ELEFT | 
|---|
| 53 | *KEEP,KAONS. | 
|---|
| 54 | COMMON /KAONS/   CKA | 
|---|
| 55 | DOUBLE PRECISION CKA(80) | 
|---|
| 56 | *KEEP,MAGNET. | 
|---|
| 57 | COMMON /MAGNET/  BX,BZ,BVAL,BNORMC,BNORM,COSB,SINB,BLIMIT | 
|---|
| 58 | DOUBLE PRECISION BX,BZ,BVAL,BNORMC | 
|---|
| 59 | REAL             BNORM,COSB,SINB,BLIMIT | 
|---|
| 60 | *KEEP,MUMULT. | 
|---|
| 61 | COMMON /MUMULT/  CHC,OMC,FMOLI | 
|---|
| 62 | DOUBLE PRECISION CHC,OMC | 
|---|
| 63 | LOGICAL          FMOLI | 
|---|
| 64 | *KEEP,MUPART. | 
|---|
| 65 | COMMON /MUPART/  AMUPAR,BCUT,CMUON,FMUBRM,FMUORG | 
|---|
| 66 | DOUBLE PRECISION AMUPAR(14),BCUT,CMUON(11) | 
|---|
| 67 | LOGICAL          FMUBRM,FMUORG | 
|---|
| 68 | *KEEP,NCSNCS. | 
|---|
| 69 | COMMON /NCSNCS/  SIGN30,SIGN45,SIGN60,SIGO30,SIGO45,SIGO60, | 
|---|
| 70 | *                 SIGA30,SIGA45,SIGA60,PNOA30,PNOA45,PNOA60, | 
|---|
| 71 | *                 SIG30A,SIG45A,SIG60A | 
|---|
| 72 | DOUBLE PRECISION SIGN30(56),SIGN45(56),SIGN60(56), | 
|---|
| 73 | *                 SIGO30(56),SIGO45(56),SIGO60(56), | 
|---|
| 74 | *                 SIGA30(56),SIGA45(56),SIGA60(56), | 
|---|
| 75 | *                 PNOA30(1540,3),PNOA45(1540,3),PNOA60(1540,3), | 
|---|
| 76 | *                 SIG30A(56),SIG45A(56),SIG60A(56) | 
|---|
| 77 | *KEEP,NKGI. | 
|---|
| 78 | COMMON /NKGI/    SEL,SELLG,STH,ZEL,ZELLG,ZSL,DIST, | 
|---|
| 79 | *                 DISX,DISY,DISXY,DISYX,DLAX,DLAY,DLAXY,DLAYX, | 
|---|
| 80 | *                 OBSATI,RADNKG,RMOL,TLEV,TLEVCM,IALT | 
|---|
| 81 | DOUBLE PRECISION SEL(10),SELLG(10),STH(10),ZEL(10),ZELLG(10), | 
|---|
| 82 | *                 ZSL(10),DIST(10), | 
|---|
| 83 | *                 DISX(-10:10),DISY(-10:10), | 
|---|
| 84 | *                 DISXY(-10:10,2),DISYX(-10:10,2), | 
|---|
| 85 | *                 DLAX (-10:10,2),DLAY (-10:10,2), | 
|---|
| 86 | *                 DLAXY(-10:10,2),DLAYX(-10:10,2), | 
|---|
| 87 | *                 OBSATI(2),RADNKG,RMOL(2),TLEV(10),TLEVCM(10) | 
|---|
| 88 | INTEGER          IALT(2) | 
|---|
| 89 | *KEEP,OBSPAR. | 
|---|
| 90 | COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP, | 
|---|
| 91 | *                 THETPR,PHIPR,NOBSLV | 
|---|
| 92 | DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10), | 
|---|
| 93 | *                 THETAP,THETPR(2),PHIP,PHIPR(2) | 
|---|
| 94 | INTEGER          NOBSLV | 
|---|
| 95 | *KEEP,PAM. | 
|---|
| 96 | COMMON /PAM/     PAMA,SIGNUM | 
|---|
| 97 | DOUBLE PRECISION PAMA(6000),SIGNUM(6000) | 
|---|
| 98 | *KEEP,PARPAR. | 
|---|
| 99 | COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C, | 
|---|
| 100 | *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL | 
|---|
| 101 | DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14), | 
|---|
| 102 | *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH | 
|---|
| 103 | INTEGER          ITYPE,LEVL | 
|---|
| 104 | *KEEP,PARPAE. | 
|---|
| 105 | DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM | 
|---|
| 106 | EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE), | 
|---|
| 107 | *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ), | 
|---|
| 108 | *                 (CURPAR(6), T   ),  (CURPAR(7), X    ), | 
|---|
| 109 | *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ), | 
|---|
| 110 | *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ), | 
|---|
| 111 | *                 (CURPAR(12),ECM ) | 
|---|
| 112 | *KEEP,PRIMSP. | 
|---|
| 113 | COMMON /PRIMSP/  PSLOPE,LLIMIT,ULIMIT,LL,UL,SLEX,ISPEC | 
|---|
| 114 | DOUBLE PRECISION PSLOPE,LLIMIT,ULIMIT,LL,UL,SLEX | 
|---|
| 115 | INTEGER          ISPEC | 
|---|
| 116 | *KEEP,RANDPA. | 
|---|
| 117 | COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR | 
|---|
| 118 | DOUBLE PRECISION FAC,U1,U2 | 
|---|
| 119 | REAL             RD(3000) | 
|---|
| 120 | INTEGER          ISEED(103,10),NSEQ | 
|---|
| 121 | LOGICAL          KNOR | 
|---|
| 122 | *KEEP,RANGE. | 
|---|
| 123 | COMMON /RANGE/   CC | 
|---|
| 124 | DOUBLE PRECISION CC(20) | 
|---|
| 125 | *KEEP,RECORD. | 
|---|
| 126 | COMMON /RECORD/  IRECOR | 
|---|
| 127 | INTEGER          IRECOR | 
|---|
| 128 | *KEEP,RUNPAR. | 
|---|
| 129 | COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB, | 
|---|
| 130 | *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN, | 
|---|
| 131 | *                 MONIOU,MDEBUG,NUCNUC, | 
|---|
| 132 | *                 CETAPE, | 
|---|
| 133 | *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL, | 
|---|
| 134 | *                 N1STTR,MDBASE, | 
|---|
| 135 | *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR, | 
|---|
| 136 | *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE | 
|---|
| 137 | *                ,GHEISH,GHESIG | 
|---|
| 138 | COMMON /RUNPAC/  DSN,HOST,USER | 
|---|
| 139 | DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB | 
|---|
| 140 | REAL             STEPFC | 
|---|
| 141 | INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC, | 
|---|
| 142 | *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL, | 
|---|
| 143 | *                 N1STTR,MDBASE | 
|---|
| 144 | INTEGER          CETAPE | 
|---|
| 145 | CHARACTER*79     DSN | 
|---|
| 146 | CHARACTER*20     HOST,USER | 
|---|
| 147 |  | 
|---|
| 148 | LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR, | 
|---|
| 149 | *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE | 
|---|
| 150 | *                ,GHEISH,GHESIG | 
|---|
| 151 | *KEEP,STACKF. | 
|---|
| 152 | COMMON /STACKF/  STACK,STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM | 
|---|
| 153 | INTEGER          MAXSTK | 
|---|
| 154 | PARAMETER        (MAXSTK = 12*340*2) | 
|---|
| 155 | DOUBLE PRECISION STACK(MAXSTK) | 
|---|
| 156 | INTEGER          STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM | 
|---|
| 157 | *KEEP,STRBAR. | 
|---|
| 158 | COMMON /STRBAR/  CSTRBA | 
|---|
| 159 | DOUBLE PRECISION CSTRBA(11) | 
|---|
| 160 | *KEEP,VERS. | 
|---|
| 161 | COMMON /VERS/    VERNUM,MVDATE,VERDAT | 
|---|
| 162 | DOUBLE PRECISION VERNUM | 
|---|
| 163 | INTEGER          MVDATE | 
|---|
| 164 | CHARACTER*18     VERDAT | 
|---|
| 165 | *KEEP,VENUS. | 
|---|
| 166 | COMMON /VENUS/   ISH0,IVERVN,MTAR99,FVENUS,FVENSG | 
|---|
| 167 | INTEGER          ISH0,IVERVN,MTAR99 | 
|---|
| 168 | LOGICAL          FVENUS,FVENSG | 
|---|
| 169 | *KEEP,CEREN3. | 
|---|
| 170 | COMMON /CEREN3/  CERCNT,DATAB2,LHCER | 
|---|
| 171 | INTEGER          MAXBF2 | 
|---|
| 172 | PARAMETER        (MAXBF2 = 39 * 7) | 
|---|
| 173 | DOUBLE PRECISION CERCNT | 
|---|
| 174 | REAL             DATAB2(MAXBF2) | 
|---|
| 175 | INTEGER          LHCER | 
|---|
| 176 | *KEND. | 
|---|
| 177 |  | 
|---|
| 178 | DOUBLE PRECISION COAN,SE,TEMP1,TEMP2,TEMP3,THICK,TTIME,ZE,ZS,ZX | 
|---|
| 179 | INTEGER          I,IA,J,L,N | 
|---|
| 180 | EXTERNAL         THICK | 
|---|
| 181 | CHARACTER*1      MARK | 
|---|
| 182 | C----------------------------------------------------------------------- | 
|---|
| 183 |  | 
|---|
| 184 | C  SAY HELLO | 
|---|
| 185 | WRITE(MONIOU,112) | 
|---|
| 186 | 112 FORMAT(/' ',120('A')// | 
|---|
| 187 | *'   OOO      OOO     OOOO       OOOO    OO   O      O      O   '/ | 
|---|
| 188 | *'  O   O    O   O    O    O    O    O   OO   O    O       O O  '/ | 
|---|
| 189 | *' O        O     O   O     O   O        OO   O  O        O   O '/ | 
|---|
| 190 | *' O        O     O   O    O     OOOO    OO   OO         O     O'/ | 
|---|
| 191 | *' O        O     O   OOOO           O   OO   O  O       OOOOOOO'/ | 
|---|
| 192 | *'  O   O    O   O    O   O     O    O   OO   O    O     O     O'/ | 
|---|
| 193 | *'   OOO      OOO     O     O    OOOO    OO   O      O   O     O'// | 
|---|
| 194 | *' COSMIC RAY SIMULATION FOR KASCADE'/// | 
|---|
| 195 | *' A PROGRAM TO SIMULATE EXTENSIVE AIR SHOWERS IN ATMOSPHERE'// | 
|---|
| 196 | *' BASED ON A PROGRAM OF P.K.F. GRIEDER, UNIVERSITY BERN,', | 
|---|
| 197 | *' SWITZERLAND'/ | 
|---|
| 198 | *' HDPM MODEL ACCORDING TO J.N. CAPDEVIELLE, COLLEGE DE FRANCE,', | 
|---|
| 199 | *' PARIS, FRANCE'/ | 
|---|
| 200 | *' VENUS MODEL ACCORDING TO K. WERNER, UNIVERSITY NANTES, FRANCE'/ | 
|---|
| 201 | *' GHEISHA ROUTINES ACCORDING TO H. FESEFELDT, RWTH. AACHEN,', | 
|---|
| 202 | *' GERMANY'/ | 
|---|
| 203 | *' EGS4 AND NKG FORMULAS FOR SIMULATION OF EL.MAG. PARTICLES'//) | 
|---|
| 204 |  | 
|---|
| 205 | MARK = '1' | 
|---|
| 206 |  | 
|---|
| 207 | WRITE(MONIOU,912) VERNUM,MARK,VERDAT | 
|---|
| 208 | 912 FORMAT(' INSTITUT FUER KERNPHYSIK '/ | 
|---|
| 209 | *       ' FORSCHUNGSZENTRUM UND UNIVERSITAET KARLSRUHE'/ | 
|---|
| 210 | *       ' POSTFACH 3640'/ | 
|---|
| 211 | *       ' D-76021 KARLSRUHE'/ | 
|---|
| 212 | *       ' GERMANY'// | 
|---|
| 213 | *       ' IN CASE OF PROBLEMS CONTACT:'/ | 
|---|
| 214 | *       '           DIETER HECK             JOHANNES KNAPP'/ | 
|---|
| 215 | *       ' E-MAIL:   HECK@IK3.FZK.DE         KNAPP@IK1.FZK.DE'/ | 
|---|
| 216 | *       ' FAX:      (49) 7247-82-4075       (49) 7247-82-3548'/ | 
|---|
| 217 | *       ' TEL:      (49) 7247-82-3777       (49) 7247-82-3549'// | 
|---|
| 218 | *       ' NUMBER OF VERSION : ',F6.3,A1/ | 
|---|
| 219 | *       ' DATE   OF VERSION : ',A18 /) | 
|---|
| 220 |  | 
|---|
| 221 | WRITE(MONIOU,141) | 
|---|
| 222 | 141 FORMAT(//' CERENKOV RADIATION IS GENERATED'/ | 
|---|
| 223 | *         ' ==============================='//) | 
|---|
| 224 |  | 
|---|
| 225 | C  INITIALIZE FIELD WITH PARTICLE MASSES | 
|---|
| 226 | CALL PAMAF | 
|---|
| 227 |  | 
|---|
| 228 |  | 
|---|
| 229 | C  READ RUN STEERING DATA CARDS | 
|---|
| 230 | CALL DATAC | 
|---|
| 231 |  | 
|---|
| 232 | C  CLEARS BUFFERS FOR HEADER AND FILLS IN PERMANENT INFORMATION | 
|---|
| 233 | DO 889  L = 1,MAXBUF | 
|---|
| 234 | EVTH(L)  = 0. | 
|---|
| 235 | EVTE(L)  = 0. | 
|---|
| 236 | RUNH(L)  = 0. | 
|---|
| 237 | RUNE(L)  = 0. | 
|---|
| 238 | DATAB(L) = 0. | 
|---|
| 239 | DATAB2(L) = 0. | 
|---|
| 240 | 889 CONTINUE | 
|---|
| 241 |  | 
|---|
| 242 |  | 
|---|
| 243 | C  PERMANENT INFORMATION | 
|---|
| 244 | C  CHARACTER STRINGS | 
|---|
| 245 | CRUNH = 'RUNH' | 
|---|
| 246 | CRUNE = 'RUNE' | 
|---|
| 247 | CEVTH = 'EVTH' | 
|---|
| 248 | CEVTE = 'EVTE' | 
|---|
| 249 |  | 
|---|
| 250 | RUNH(2)  = NRRUN | 
|---|
| 251 | RUNE(2)  = NRRUN | 
|---|
| 252 | EVTH(44) = NRRUN | 
|---|
| 253 |  | 
|---|
| 254 | C  DATE OF RUN | 
|---|
| 255 | WRITE(MONIOU,101) | 
|---|
| 256 | 101  FORMAT(//' ',10('='),' START OF RUN ',55('=')) | 
|---|
| 257 | CALL PRTIME(TTIME) | 
|---|
| 258 | RUNH(3)  = TTIME | 
|---|
| 259 | EVTH(45) = TTIME | 
|---|
| 260 |  | 
|---|
| 261 | C  VERSION OF PROGRAM | 
|---|
| 262 | RUNH(4)  = VERNUM | 
|---|
| 263 | EVTH(46) = VERNUM | 
|---|
| 264 |  | 
|---|
| 265 | C----------------------------------------------------------------------- | 
|---|
| 266 | C  INITIALISATION FOR RANDOM NUMBER GENERATOR | 
|---|
| 267 | IF ( FEGS  .AND.  NSEQ .LT. 2 ) NSEQ = 2 | 
|---|
| 268 | C  CERENKOV SELECTION DEMANDS ALWAYS EGS CALCULATION | 
|---|
| 269 | FEGS = .TRUE. | 
|---|
| 270 | C  IN CASE OF CERENKOV CALCULATIONS THE 3. RANDOM SEQUENCE IS NEEDED | 
|---|
| 271 | IF ( NSEQ .LT. 3 ) NSEQ = 3 | 
|---|
| 272 | DO 281  I = 1,NSEQ | 
|---|
| 273 | IF ( .NOT. DEBUG   .AND.  .NOT. DEBDEL   .AND. | 
|---|
| 274 | *      (ISEED(2,I) .GT. 1000  .OR.  ISEED(3,I) .GT. 0) ) THEN | 
|---|
| 275 | WRITE(MONIOU,2811)  I | 
|---|
| 276 | 2811      FORMAT(/' #########################################'/ | 
|---|
| 277 | *            ' ##  IMPROPER INITIALIZATION OF RANDOM  ##'/ | 
|---|
| 278 | *            ' ##   NUMBER GENERATOR SEQUENCE ',I6,'  ##'/ | 
|---|
| 279 | *            ' ##     IS EXTREMELY TIME CONSUMING     ##'/ | 
|---|
| 280 | *            ' ##       PLEASE READ THE MANUALS       ##'/ | 
|---|
| 281 | *            ' #########################################'/) | 
|---|
| 282 | ENDIF | 
|---|
| 283 | CALL RMMAQ( ISEED(1,I), I, 'S' ) | 
|---|
| 284 | 281 CONTINUE | 
|---|
| 285 | KNOR = .TRUE. | 
|---|
| 286 |  | 
|---|
| 287 | WRITE(MONIOU,158) (L,(ISEED(J,L),J=1,3),L=1,NSEQ) | 
|---|
| 288 | 158 FORMAT (/' RANDOM NUMBER GENERATOR AT BEGIN OF RUN :'/ | 
|---|
| 289 | *        (' SEQUENCE = ',I2,'  SEED = ',I9,'  CALLS = ',I9, | 
|---|
| 290 | *         '  BILLIONS = ',I9)) | 
|---|
| 291 |  | 
|---|
| 292 | C----------------------------------------------------------------------- | 
|---|
| 293 | C  READ CROSS SECTIONS AND PROBABILITIES FOR NUCLEUS-NUCLEUS COLLISIONS | 
|---|
| 294 | OPEN(UNIT=NUCNUC,FILE='NUCNUCCS',STATUS='OLD') | 
|---|
| 295 | READ(NUCNUC,500) SIGN30,SIGN45,SIGN60,SIGO30,SIGO45,SIGO60, | 
|---|
| 296 | *                 SIGA30,SIGA45,SIGA60 | 
|---|
| 297 | READ(NUCNUC,500) (PNOA30(I,1),I=1,1540),(PNOA45(I,1),I=1,1540), | 
|---|
| 298 | *                 (PNOA60(I,1),I=1,1540),(PNOA30(I,2),I=1,1540), | 
|---|
| 299 | *                 (PNOA45(I,2),I=1,1540),(PNOA60(I,2),I=1,1540), | 
|---|
| 300 | *                 (PNOA30(I,3),I=1,1540),(PNOA45(I,3),I=1,1540), | 
|---|
| 301 | *                 (PNOA60(I,3),I=1,1540) | 
|---|
| 302 | 500  FORMAT( 5E16.10 ) | 
|---|
| 303 | CLOSE(UNIT=NUCNUC) | 
|---|
| 304 |  | 
|---|
| 305 | C  INELASTIC CROSS SECTIONS FOR PROJECTICLE WITH MASS NUMBER IA | 
|---|
| 306 | DO 501  IA = 1,56 | 
|---|
| 307 | SIG30A(IA) = COMPOS(1)*SIGN30(IA) + COMPOS(2)*SIGO30(IA) | 
|---|
| 308 | *                                    + COMPOS(3)*SIGA30(IA) | 
|---|
| 309 | SIG45A(IA) = COMPOS(1)*SIGN45(IA) + COMPOS(2)*SIGO45(IA) | 
|---|
| 310 | *                                    + COMPOS(3)*SIGA45(IA) | 
|---|
| 311 | SIG60A(IA) = COMPOS(1)*SIGN60(IA) + COMPOS(2)*SIGO60(IA) | 
|---|
| 312 | *                                    + COMPOS(3)*SIGA60(IA) | 
|---|
| 313 |  | 
|---|
| 314 | IF (DEBUG) WRITE(MDEBUG,544) IA,SIG30A(IA),SIG45A(IA),SIG60A(IA) | 
|---|
| 315 | 544    FORMAT(' START : CROSS SECTIONS A-AIR : A=',I2,1P,3E14.6) | 
|---|
| 316 | 501  CONTINUE | 
|---|
| 317 |  | 
|---|
| 318 | WRITE(MONIOU,503) | 
|---|
| 319 | 503  FORMAT (//' ',10('='),' INTERACTION MODELS ',49('=')) | 
|---|
| 320 | C  HIGH ENERGY HADRONIC INTERACTION MODEL | 
|---|
| 321 | IF ( FVENUS ) THEN | 
|---|
| 322 | WRITE(MONIOU,*) 'VENUS TREATS HIGH ENERGY HADRONIC INTERACTIONS' | 
|---|
| 323 | CALL VENINI | 
|---|
| 324 | IF ( .NOT. GHEISH ) THEN | 
|---|
| 325 | GHEISH = .TRUE. | 
|---|
| 326 | WRITE(MONIOU,*)'GHEISHA OPTION NOT SELECTED, BUT SWITCHED ON' | 
|---|
| 327 | ENDIF | 
|---|
| 328 | IF     ( NFRAGM .EQ. 0 ) THEN | 
|---|
| 329 | WRITE(MONIOU,*) | 
|---|
| 330 | *    ' TOTAL FRAGMENTATION OF PRIMARY NUCLEUS IN FIRST INTERACTION' | 
|---|
| 331 | ELSEIF ( NFRAGM .EQ. 1 ) THEN | 
|---|
| 332 | WRITE(MONIOU,*) | 
|---|
| 333 | *      ' NO FRAGMENTATION, NO EVAPORATION OF REMAINDER' | 
|---|
| 334 | ELSEIF ( NFRAGM .EQ. 2 ) THEN | 
|---|
| 335 | WRITE(MONIOU,1504) | 
|---|
| 336 | ELSEIF ( NFRAGM .EQ. 3 ) THEN | 
|---|
| 337 | WRITE(MONIOU,1505) | 
|---|
| 338 | ELSE | 
|---|
| 339 | NFRAGM = 4 | 
|---|
| 340 | WRITE(MONIOU,1507) | 
|---|
| 341 | ENDIF | 
|---|
| 342 | WRITE(MONIOU,*) | 
|---|
| 343 | ELSE | 
|---|
| 344 | WRITE(MONIOU,1506) | 
|---|
| 345 | ENDIF | 
|---|
| 346 | 1506  FORMAT(' HDPM ROUTINES TREAT HIGH ENERGY HADRONIC INTERACTIONS') | 
|---|
| 347 |  | 
|---|
| 348 |  | 
|---|
| 349 | IF ( .NOT. FVENUS ) THEN | 
|---|
| 350 | C  INPUT FLAGS FOR HDPM OPTIONS | 
|---|
| 351 | WRITE(MONIOU,*)'HDPM GENERATOR SPECIFICATIONS ARE:' | 
|---|
| 352 | IF ( NFLAIN .EQ. 0 ) THEN | 
|---|
| 353 | WRITE(MONIOU,*) ' RANDOM NUMBER OF INTERACTIONS IN AIR TARGET' | 
|---|
| 354 | IF ( NFLDIF .EQ. 0 ) THEN | 
|---|
| 355 | WRITE(MONIOU,*) ' NO DIFFRACTIVE SECOND INTERACTIONS' | 
|---|
| 356 | ELSE | 
|---|
| 357 | WRITE(MONIOU,*) ' DIFFRACTIVE SECOND INTERACTIONS' | 
|---|
| 358 | ENDIF | 
|---|
| 359 | ELSE | 
|---|
| 360 | WRITE(MONIOU,*) ' FIXED NUMBER OF INTERACTIONS IN AIR TARGET' | 
|---|
| 361 | ENDIF | 
|---|
| 362 | IF ( NFLPI0 .EQ. 0 ) THEN | 
|---|
| 363 | WRITE(MONIOU,*) ' RAPIDITY OF PI0 ACCORDING TO COLLIDER DATA' | 
|---|
| 364 | ELSE | 
|---|
| 365 | WRITE(MONIOU,*) ' RAPIDITY OF PI0 SAME AS THAT OF CHARGED' | 
|---|
| 366 | ENDIF | 
|---|
| 367 | IF ( NFLPIF .EQ. 0 ) THEN | 
|---|
| 368 | WRITE(MONIOU,*) ' NO FLUCTUATIONS OF NUMBER OF PI0' | 
|---|
| 369 | ELSE | 
|---|
| 370 | WRITE(MONIOU,*)' FLUCTUATIONS OF NUMBER OF PI0 AS MEASURED ', | 
|---|
| 371 | *         'AT THE COLLIDER' | 
|---|
| 372 | ENDIF | 
|---|
| 373 | IF ( NFLCHE .EQ. 0 ) THEN | 
|---|
| 374 | WRITE(MONIOU,*) ' CHARGE EXCHANGE INTERACTION POSSIBLE ' | 
|---|
| 375 | ELSE | 
|---|
| 376 | WRITE(MONIOU,*) ' NO CHARGE EXCHANGE INTERACTION POSSIBLE ' | 
|---|
| 377 | ENDIF | 
|---|
| 378 | IF     ( NFRAGM .EQ. 0 ) THEN | 
|---|
| 379 | WRITE(MONIOU,*)' TOTAL FRAGMENTION OF PRIMARY NUCLEUS IN ', | 
|---|
| 380 | *          'FIRST INTERACTION' | 
|---|
| 381 | ELSEIF ( NFRAGM .EQ. 1 ) THEN | 
|---|
| 382 | WRITE(MONIOU,*) ' NO FRAGMENTATION, NO EVAPORATION OF REMAINDER' | 
|---|
| 383 | ELSEIF ( NFRAGM .EQ. 2 ) THEN | 
|---|
| 384 | WRITE(MONIOU,1504) | 
|---|
| 385 | 1504    FORMAT('  NO FRAGMENTATION, EVAPORATION OF REMAINDER ', | 
|---|
| 386 | *           ' (PT AFTER JACEE)') | 
|---|
| 387 | ELSEIF ( NFRAGM .EQ. 3 ) THEN | 
|---|
| 388 | WRITE(MONIOU,1505) | 
|---|
| 389 | 1505    FORMAT('  NO FRAGMENTATION, EVAPORATION OF REMAINDER ', | 
|---|
| 390 | *           ' (PT AFTER GOLDHABER)') | 
|---|
| 391 | ELSE | 
|---|
| 392 | NFRAGM = 4 | 
|---|
| 393 | WRITE(MONIOU,1507) | 
|---|
| 394 | 1507    FORMAT('  NO FRAGMENTATION, EVAPORATION OF REMAINDER ', | 
|---|
| 395 | *           ' (WITH PT = 0.)') | 
|---|
| 396 | ENDIF | 
|---|
| 397 | ENDIF | 
|---|
| 398 | WRITE(MONIOU,*) | 
|---|
| 399 |  | 
|---|
| 400 | C  LOW ENERGY HADRONIC INTERACTION MODEL | 
|---|
| 401 | IF ( GHEISH ) THEN | 
|---|
| 402 | WRITE(MONIOU,*) 'GHEISHA TREATS LOW ENERGY HADRONIC ', | 
|---|
| 403 | *                  'INTERACTIONS' | 
|---|
| 404 | CALL CGHINI | 
|---|
| 405 | ELSE | 
|---|
| 406 | WRITE(MONIOU,*) 'ISOBAR ROUTINES TREAT LOW ENERGY HADRONIC ', | 
|---|
| 407 | *                  'INTERACTIONS' | 
|---|
| 408 | HILOELB = 53.D0 | 
|---|
| 409 | ENDIF | 
|---|
| 410 |  | 
|---|
| 411 | C  WRITE HADRONIC STEERING FLAGS TO RUNHEADER | 
|---|
| 412 | RUNH(270) = NFLAIN | 
|---|
| 413 | RUNH(271) = NFLDIF | 
|---|
| 414 | RUNH(272) = NFLPI0 + 100. * NFLPIF | 
|---|
| 415 | RUNH(273) = NFLCHE + 100. * NFRAGM | 
|---|
| 416 |  | 
|---|
| 417 | EVTH(65)  = NFLAIN | 
|---|
| 418 | EVTH(66)  = NFLDIF | 
|---|
| 419 | EVTH(67)  = NFLPI0 | 
|---|
| 420 | EVTH(68)  = NFLPIF | 
|---|
| 421 | EVTH(69)  = NFLCHE | 
|---|
| 422 | EVTH(70)  = NFRAGM | 
|---|
| 423 |  | 
|---|
| 424 | HILOECM = SQRT(2.D0*PAMA(14)*(PAMA(14) + HILOELB)) | 
|---|
| 425 | WRITE(MONIOU,*) 'START: HIGH ENERGY INTERACTION MODEL USED ABOVE' | 
|---|
| 426 | WRITE(MONIOU,*)  '     ',HILOELB,' GEV LAB ENERGY   OR' | 
|---|
| 427 | WRITE(MONIOU,*)  '     ',HILOECM,' GEV CM ENERGY' | 
|---|
| 428 |  | 
|---|
| 429 | C  INPUT STEERING FLAGS FOR ELECTROMAGNETIC PART | 
|---|
| 430 | WRITE(MONIOU,*) | 
|---|
| 431 | IF ( FNKG ) THEN | 
|---|
| 432 | WRITE(MONIOU,*)'ELECTROMAGNETIC COMPONENT SIMULATED WITH NKG' | 
|---|
| 433 | IF ( ULIMIT .GT. 2.D7 ) THEN | 
|---|
| 434 | WRITE(MONIOU,*)'#############################################' | 
|---|
| 435 | WRITE(MONIOU,*)'#  W A R N I N G  NKG IS WITHOUT LPM EFFECT #' | 
|---|
| 436 | WRITE(MONIOU,*)'#############################################' | 
|---|
| 437 | ENDIF | 
|---|
| 438 | WRITE(MONIOU,*) | 
|---|
| 439 | ENDIF | 
|---|
| 440 | IF ( FEGS ) THEN | 
|---|
| 441 | WRITE(MONIOU,*)'ELECTROMAGNETIC COMPONENT SIMULATED WITH EGS4' | 
|---|
| 442 | WRITE(MONIOU,*) | 
|---|
| 443 | ENDIF | 
|---|
| 444 | IF ( .NOT. (FNKG .OR. FEGS) ) WRITE(MONIOU,*) | 
|---|
| 445 | *              'ELECTROMAGNETIC COMPONENT IS NOT SIMULATED' | 
|---|
| 446 | IF ( FEGS ) THEN | 
|---|
| 447 | IF ( STEPFC .GT. 10.  .OR.  STEPFC .LE. 0. ) THEN | 
|---|
| 448 | WRITE(MONIOU,*)'STEP LENGTH FACTOR FOR ELECTRON MULTIPLE ', | 
|---|
| 449 | *       'SCATTERING =',STEPFC,' NOT CORRECT' | 
|---|
| 450 | WRITE(MONIOU,*)'PLEASE READ THE MANUALS' | 
|---|
| 451 | STOP | 
|---|
| 452 | ENDIF | 
|---|
| 453 | IF ( STEPFC .LT. 10. ) WRITE(MONIOU,*)'STEP LENGTH ', | 
|---|
| 454 | *            'FACTOR FOR ELECTRON MULTIPLE SCATTERING =',STEPFC | 
|---|
| 455 | C  INITIALIZE EGS4 PACKAGE | 
|---|
| 456 | CALL EGSINI | 
|---|
| 457 | IF ( ULIMIT .GT. 2.D7 ) THEN | 
|---|
| 458 | WRITE(MONIOU,*)'#############################################' | 
|---|
| 459 | WRITE(MONIOU,*)'#  W A R N I N G  EGS IS WITHOUT LPM EFFECT #' | 
|---|
| 460 | WRITE(MONIOU,*)'#############################################' | 
|---|
| 461 | ENDIF | 
|---|
| 462 | ENDIF | 
|---|
| 463 | C  WRITE STEERING FLAGS FOR ELECTROMAGNETIC PART AS REAL TO HEADER | 
|---|
| 464 | IF ( FNKG ) THEN | 
|---|
| 465 | RUNH(20) = 1. | 
|---|
| 466 | EVTH(74) = 1. | 
|---|
| 467 | ELSE | 
|---|
| 468 | RUNH(20) = 0. | 
|---|
| 469 | EVTH(74) = 0. | 
|---|
| 470 | ENDIF | 
|---|
| 471 | IF ( FEGS ) THEN | 
|---|
| 472 | RUNH(19) = 1. | 
|---|
| 473 | EVTH(73) = 1. | 
|---|
| 474 | ELSE | 
|---|
| 475 | RUNH(19) = 0. | 
|---|
| 476 | EVTH(73) = 0. | 
|---|
| 477 | ENDIF | 
|---|
| 478 |  | 
|---|
| 479 | EVTH(95) = STEPFC | 
|---|
| 480 |  | 
|---|
| 481 | C  PROGRAM CONFIGURATIONS FOR EVENT HEADER | 
|---|
| 482 | IF ( GHEISH ) THEN | 
|---|
| 483 | EVTH(75) = 1. | 
|---|
| 484 | ELSE | 
|---|
| 485 | EVTH(75) = 0. | 
|---|
| 486 | ENDIF | 
|---|
| 487 | IF ( FVENUS ) THEN | 
|---|
| 488 | EVTH(76) = 1. | 
|---|
| 489 | ELSE | 
|---|
| 490 | EVTH(76) = 0. | 
|---|
| 491 | ENDIF | 
|---|
| 492 | EVTH(139) = 0. | 
|---|
| 493 | EVTH(140) = 0. | 
|---|
| 494 | EVTH(141) = 0. | 
|---|
| 495 | EVTH(142) = 0. | 
|---|
| 496 | EVTH(143) = 0. | 
|---|
| 497 | EVTH(144) = 0. | 
|---|
| 498 | EVTH(145) = 0. | 
|---|
| 499 | EVTH(77) = 1. | 
|---|
| 500 | EVTH(78) = 0. | 
|---|
| 501 | EVTH(79) = 0. | 
|---|
| 502 | EVTH(80) = 3. | 
|---|
| 503 |  | 
|---|
| 504 | C----------------------------------------------------------------------- | 
|---|
| 505 | C  BEGIN OF TAPE FOR IBM,  FOR TRANSPUTER SEE BEGIN OF EVT | 
|---|
| 506 |  | 
|---|
| 507 | C----------------------------------------------------------------------- | 
|---|
| 508 | C  PHYSICAL CONSTANTS | 
|---|
| 509 | ENEPER  = EXP(1.D0) | 
|---|
| 510 | C(6)    = ( PAMA(5) / PAMA(11) )**2 | 
|---|
| 511 | C(7)    = ( PAMA(5) / PAMA(8) )**2 | 
|---|
| 512 | C(8)    = ( PAMA(5)**2 + PAMA(2)**2 ) * 0.5D0 / PAMA(5) | 
|---|
| 513 | C(20)   = 10.D0 * C(21) | 
|---|
| 514 | C(27)   = COS( C(26) ) | 
|---|
| 515 | C(29)   = COS( C(28) ) | 
|---|
| 516 | C(44)   = MAX( PAMA(8)+C(4), PAMA(14)+C(5) ) | 
|---|
| 517 | C(45)   = PAMA(8) * PAMA(14) * 2.D0 | 
|---|
| 518 | C(46)   = PAMA(8)**2 + PAMA(14)**2 | 
|---|
| 519 | C(48)   = (PAMA(8)**2 + PAMA(5)**2) / (2.D0*PAMA(8)*PAMA(5)) | 
|---|
| 520 | C(49)   = SQRT(C(48)**2 - 1.D0) / C(48) | 
|---|
| 521 |  | 
|---|
| 522 | CKA(13) = 2.D0 * PAMA(11) * PAMA(14) | 
|---|
| 523 | CKA(14) = PAMA(11)**2 + PAMA(14)**2 | 
|---|
| 524 | CKA(17) = SQRT( ( (PAMA(11)**2 + PAMA(5)**2) | 
|---|
| 525 | *          / (2.D0*PAMA(11)) )**2 - PAMA(5)**2 ) | 
|---|
| 526 | CKA(18) = SQRT( ( (PAMA(11)**2 + PAMA(8)**2 - PAMA(7)**2) | 
|---|
| 527 | *          / (2.D0*PAMA(11)) )**2 - PAMA(8)**2 ) | 
|---|
| 528 | CKA(22) = MAX( C(5)+PAMA(14), PAMA(11)+C(4) ) | 
|---|
| 529 | CKA(28) = SQRT(1.D0 + CKA(17)**2/PAMA(5)**2) | 
|---|
| 530 | CKA(29) = SQRT(1.D0 - 1.D0/CKA(28)**2) | 
|---|
| 531 | CKA(30) = SQRT(1.D0 + CKA(18)**2/PAMA(8)**2) | 
|---|
| 532 | CKA(31) = SQRT(1.D0 - 1.D0/CKA(30)**2) | 
|---|
| 533 | CKA(41) = PAMA(16) | 
|---|
| 534 | CKA(42) = (PAMA(11)**2 + PAMA(7)**2 - PAMA(8)**2) / | 
|---|
| 535 | *          (2.D0*PAMA(11)*PAMA(7)) | 
|---|
| 536 | CKA(43) = CKA(41) / (2.D0*PAMA(7)) | 
|---|
| 537 | CKA(44) = SQRT(1.D0 - 1.D0/CKA(43)**2) | 
|---|
| 538 | CKA(45) = CKA(41) / (2.D0*PAMA(8)) | 
|---|
| 539 | CKA(46) = SQRT(1.D0 - 1.D0/CKA(45)**2) | 
|---|
| 540 |  | 
|---|
| 541 | C  SET CONSTANTS FOR MUON BREMSSTRAHLUNG | 
|---|
| 542 | CMUON(3)  =  7.D0**OB3 | 
|---|
| 543 | CMUON(6)  =  8.D0**OB3 | 
|---|
| 544 | CMUON(9)  = 18.D0**OB3 | 
|---|
| 545 | CMUON(1)  = LOG( 189.D0 * PAMA(5) / (CMUON(3)*PAMA(2)) ) | 
|---|
| 546 | CMUON(4)  = LOG( 189.D0 * PAMA(5) / (CMUON(6)*PAMA(2)) ) | 
|---|
| 547 | CMUON(7)  = LOG( 189.D0 * PAMA(5) / (CMUON(9)*PAMA(2)) ) | 
|---|
| 548 | *                   + LOG( TB3/CMUON(9) ) | 
|---|
| 549 | SE        = SQRT(EXP(1.D0)) | 
|---|
| 550 | CMUON(2)  = 189.D0 * SE*PAMA(5)**2/(2.D0*PAMA(2)*CMUON(3)) | 
|---|
| 551 | CMUON(5)  = 189.D0 * SE*PAMA(5)**2/(2.D0*PAMA(2)*CMUON(6)) | 
|---|
| 552 | CMUON(8)  = 189.D0 * SE*PAMA(5)**2/(2.D0*PAMA(2)*CMUON(9)) | 
|---|
| 553 | CMUON(10) = 0.75D0 * PAMA(5) * SE | 
|---|
| 554 | CMUON(3)  = CMUON(3) * CMUON(10) | 
|---|
| 555 | CMUON(6)  = CMUON(6) * CMUON(10) | 
|---|
| 556 | CMUON(9)  = CMUON(9) * CMUON(10) | 
|---|
| 557 | CMUON(11) = LOG( BCUT/PAMA(5) ) | 
|---|
| 558 |  | 
|---|
| 559 | DO  1  I = 1,50 | 
|---|
| 560 | CANN(I) = 0.D0 | 
|---|
| 561 | 1 CONTINUE | 
|---|
| 562 | COAN = 0.D0 | 
|---|
| 563 | DO 25  N = 1,12 | 
|---|
| 564 | COAN    = COAN + CAN(N) | 
|---|
| 565 | CANN(N) = COAN | 
|---|
| 566 | 25 CONTINUE | 
|---|
| 567 | COAN = 0.D0 | 
|---|
| 568 | DO 26  N = 13,26 | 
|---|
| 569 | COAN    = COAN + CAN(N) | 
|---|
| 570 | CANN(N) = COAN | 
|---|
| 571 | 26 CONTINUE | 
|---|
| 572 |  | 
|---|
| 573 | C----------------------------------------------------------------------- | 
|---|
| 574 | C  INITIALIZE CONSTANTS FOR MUON MULTIPLE SCATTERING (MOLIERE) | 
|---|
| 575 | C  SEE SUBROUTINE GMOLI OF GEANT321 (CERN) | 
|---|
| 576 | IF (FMOLI) THEN | 
|---|
| 577 | TEMP1 = COMPOS(1) *  7.D0 *  8.D0 / 14.D0 | 
|---|
| 578 | TEMP2 = COMPOS(2) *  8.D0 *  9.D0 / 16.D0 | 
|---|
| 579 | TEMP3 = COMPOS(3) * 18.D0 * 19.D0 / 40.D0 | 
|---|
| 580 | ZS  = TEMP1 + TEMP2 + TEMP3 | 
|---|
| 581 | ZE  = -TB3*(TEMP1*LOG(7.D0) +TEMP2*LOG(8.D0) +TEMP3*LOG(18.D0)) | 
|---|
| 582 | ZX  =  TEMP1*LOG(1.D0 + 3.34D0 * ( 7.D0/C(50))**2) | 
|---|
| 583 | *        +TEMP2*LOG(1.D0 + 3.34D0 * ( 8.D0/C(50))**2) | 
|---|
| 584 | *        +TEMP3*LOG(1.D0 + 3.34D0 * (18.D0/C(50))**2) | 
|---|
| 585 | C  NOTE: CHC IS DEFINED DIFFERENT FROM GEANT WITHOUT DENSITY | 
|---|
| 586 | CHC = 0.39612D-3 * SQRT(ZS) | 
|---|
| 587 | C  NOTE: OMC IS DEFINED DIFFERENT FROM GEANT WITHOUT DENSITY | 
|---|
| 588 | OMC = 6702.33D0 * ZS * EXP( (ZE-ZX)/ZS ) | 
|---|
| 589 | EVTH(146) = 1. | 
|---|
| 590 | ELSE | 
|---|
| 591 | EVTH(146) = 0. | 
|---|
| 592 | ENDIF | 
|---|
| 593 |  | 
|---|
| 594 | C----------------------------------------------------------------------- | 
|---|
| 595 | C  TEST ON INPUT VALUES | 
|---|
| 596 |  | 
|---|
| 597 | C  PRINT CONTROL OUTPUT | 
|---|
| 598 | IF ( CC(1)         .GE. CC(2)     .OR. | 
|---|
| 599 | *     CC(2)         .GE. CC(3)     .OR. | 
|---|
| 600 | *     CC(3)         .GE. CC(4)     .OR. | 
|---|
| 601 | *     CC(5)         .GE. CC(6)     .OR. | 
|---|
| 602 | *     CC(6)         .GE. CC(7)     .OR. | 
|---|
| 603 | *     CC(7)         .GE. CC(8)     .OR. | 
|---|
| 604 | *     CC(9)         .GE. CC(10)    .OR. | 
|---|
| 605 | *     CC(10)        .GE. CC(11)    .OR. | 
|---|
| 606 | *     CC(11)        .GE. CC(12)    .OR. | 
|---|
| 607 | *     PAMA(14)+C(3) .GT. CC(1)     .OR. | 
|---|
| 608 | *     PAMA(14)+C(4) .GT. CC(2)     .OR. | 
|---|
| 609 | *     C(4)*2.       .GT. CC(3)     .OR. | 
|---|
| 610 | *     C(3)+PAMA(8)  .GT. CC(5)     .OR. | 
|---|
| 611 | *     C(44)         .GT. CC(6)     .OR. | 
|---|
| 612 | *     C(4)+C(5)     .GT. CC(7)     .OR. | 
|---|
| 613 | *     PAMA(14)+C(4) .GE. C(4)*2.   .OR. | 
|---|
| 614 | *     C(44)         .GE. C(4)+C(5)        ) THEN | 
|---|
| 615 | WRITE(MONIOU,106) | 
|---|
| 616 | 106   FORMAT (' ERROR OR INCOMPATIBILITY IN CONSTANTS') | 
|---|
| 617 | C  PRINT CONTROL OUTPUT | 
|---|
| 618 | WRITE(MONIOU,103) (C(I),I=1,50) | 
|---|
| 619 | 103   FORMAT (//' ',10('='),' CONSTANTS AND PARAMETERS ',43('=') | 
|---|
| 620 | *          //' PHYSICAL CONSTANTS (C)' // (1P,4(E15.8,1X),E15.8) ) | 
|---|
| 621 | WRITE(MONIOU,110) (CKA(I),I=1,80) | 
|---|
| 622 | 110   FORMAT (//' CONSTANTS FOR KAONS CKA(1) TO CKA(40)' | 
|---|
| 623 | *          // (1P,4(E15.8,1X),E15.8) ) | 
|---|
| 624 | WRITE(MONIOU,114) (CETA(I),I=1,5) | 
|---|
| 625 | 114   FORMAT (//' CONSTANTS FOR ETAS CETA(1) TO CETA(5)' | 
|---|
| 626 | *          // (1P,4(E15.8,1X),E15.8) ) | 
|---|
| 627 | WRITE(MONIOU,115) (CSTRBA(I),I=1,11) | 
|---|
| 628 | 115   FORMAT (//' CONSTANTS FOR STRANGE BARYONS CSTRBA(1) TO ', | 
|---|
| 629 | *            'CSTRBA(11)'// (1P,4(E15.8,1X),E15.8) ) | 
|---|
| 630 | WRITE(MONIOU,206) (CAN(I),I=1,30) | 
|---|
| 631 | 206   FORMAT (//' ANNIHILATION PARAMETERS, SET 1 (CAN)' | 
|---|
| 632 | *          // (1P,4(E15.8,1X),E15.8) ) | 
|---|
| 633 | WRITE(MONIOU,209) (CANN(I),I=1,30) | 
|---|
| 634 | 209   FORMAT (//' ANNIHILATION PARAMETERS, SET 2 (CANN)' | 
|---|
| 635 | *          // (1P,4(E15.8,1X),E15.8) ) | 
|---|
| 636 | WRITE(MONIOU,60) (CC(I),I=1,12) | 
|---|
| 637 | 60   FORMAT (//' THRESHOLD ENERGIES OF INTERACTION INTERVALS IN GEV', | 
|---|
| 638 | *          ' (CC)'// (1P,4(E15.8,1X),E15.8) ) | 
|---|
| 639 | WRITE(MONIOU,106) | 
|---|
| 640 | STOP | 
|---|
| 641 | ENDIF | 
|---|
| 642 |  | 
|---|
| 643 | C  FILL CONSTANTS IN RUN HEADER | 
|---|
| 644 | DO 3001  L = 1,50 | 
|---|
| 645 | RUNH(24+L)  = C(L) | 
|---|
| 646 | RUNH(154+L) = CAN(L) | 
|---|
| 647 | RUNH(204+L) = CANN(L) | 
|---|
| 648 | 3001 CONTINUE | 
|---|
| 649 | DO 3002  L = 1,20 | 
|---|
| 650 | RUNH(74+L)  = CC(L) | 
|---|
| 651 | 3002 CONTINUE | 
|---|
| 652 | DO 3003  L = 1,40 | 
|---|
| 653 | RUNH(94+L)  = CKA(L) | 
|---|
| 654 | 3003 CONTINUE | 
|---|
| 655 | DO 3004  L = 1,5 | 
|---|
| 656 | RUNH(134+L)  = CETA(L) | 
|---|
| 657 | 3004 CONTINUE | 
|---|
| 658 | DO 3005  L = 1,11 | 
|---|
| 659 | RUNH(139+L)  = CSTRBA(L) | 
|---|
| 660 | 3005 CONTINUE | 
|---|
| 661 | DO 3007  L = 1,5 | 
|---|
| 662 | RUNH(254+L) = AATM(L) | 
|---|
| 663 | RUNH(259+L) = BATM(L) | 
|---|
| 664 | RUNH(264+L) = CATM(L) | 
|---|
| 665 | DATM(L)     = 1.D0 / CATM(L) | 
|---|
| 666 | 3007 CONTINUE | 
|---|
| 667 |  | 
|---|
| 668 | C  SET LOWER BOUNDARIES OF THE AIR LAYERS | 
|---|
| 669 | HLAY(1)   = 0.D0 | 
|---|
| 670 | HLAY(2)   = 4.D5 | 
|---|
| 671 | HLAY(3)   = 1.D6 | 
|---|
| 672 | HLAY(4)   = 4.D6 | 
|---|
| 673 | HLAY(5)   = 1.D7 | 
|---|
| 674 | C  CALCULATE THICKNESS AT LOWER BOUNDARIES OF AIR LAYERS | 
|---|
| 675 | DO 100 L= 1,5 | 
|---|
| 676 | THICKL(L) = THICK(HLAY(L)) | 
|---|
| 677 | 100  CONTINUE | 
|---|
| 678 |  | 
|---|
| 679 | CALL STAEND | 
|---|
| 680 |  | 
|---|
| 681 | RETURN | 
|---|
| 682 | END | 
|---|