| 1 | C=======================================================================
|
|---|
| 2 |
|
|---|
| 3 | SUBROUTINE INPRM
|
|---|
| 4 |
|
|---|
| 5 | C-----------------------------------------------------------------------
|
|---|
| 6 | C IN(PUT) PR(I)M(ARY)
|
|---|
| 7 | C
|
|---|
| 8 | C TAKES INPUT PRIMARY ENERGY FROM SPECIFIED SPECTRUM
|
|---|
| 9 | C CHECKS INPUT VARIABLES FOR CONSISTENCY AND LIMITATIONS
|
|---|
| 10 | C WRITES DATA BASE FILE
|
|---|
| 11 | C THIS SUBROUTINE IS CALLED FROM MAIN
|
|---|
| 12 | C-----------------------------------------------------------------------
|
|---|
| 13 |
|
|---|
| 14 | IMPLICIT NONE
|
|---|
| 15 | *KEEP,ATMOS.
|
|---|
| 16 | COMMON /ATMOS/ AATM,BATM,CATM,DATM
|
|---|
| 17 | DOUBLE PRECISION AATM(5),BATM(5),CATM(5),DATM(5)
|
|---|
| 18 | *KEEP,BUFFS.
|
|---|
| 19 | COMMON /BUFFS/ RUNH,RUNE,EVTH,EVTE,DATAB,LH
|
|---|
| 20 | INTEGER MAXBUF,MAXLEN
|
|---|
| 21 | PARAMETER (MAXBUF=39*7)
|
|---|
| 22 | PARAMETER (MAXLEN=12)
|
|---|
| 23 | REAL RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
|
|---|
| 24 | * RUNE(MAXBUF),DATAB(MAXBUF)
|
|---|
| 25 | INTEGER LH
|
|---|
| 26 | CHARACTER*4 CRUNH,CRUNE,CEVTH,CEVTE
|
|---|
| 27 | EQUIVALENCE (RUNH(1),CRUNH), (RUNE(1),CRUNE)
|
|---|
| 28 | EQUIVALENCE (EVTH(1),CEVTH), (EVTE(1),CEVTE)
|
|---|
| 29 | *KEEP,CONST.
|
|---|
| 30 | COMMON /CONST/ PI,PI2,OB3,TB3,ENEPER
|
|---|
| 31 | DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
|
|---|
| 32 | *KEEP,DPMFLG.
|
|---|
| 33 | COMMON /DPMFLG/ NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
|
|---|
| 34 | INTEGER NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
|
|---|
| 35 | *KEEP,ELABCT.
|
|---|
| 36 | COMMON /ELABCT/ ELCUT
|
|---|
| 37 | DOUBLE PRECISION ELCUT(4)
|
|---|
| 38 | *KEEP,ETHMAP.
|
|---|
| 39 | COMMON /ETHMAP/ ECTMAP,ELEFT
|
|---|
| 40 | DOUBLE PRECISION ECTMAP,ELEFT
|
|---|
| 41 | *KEEP,LONGI.
|
|---|
| 42 | COMMON /LONGI/ APLONG,HLONG,PLONG,SPLONG,THSTEP,THSTPI,
|
|---|
| 43 | * NSTEP,LLONGI,FLGFIT
|
|---|
| 44 | DOUBLE PRECISION APLONG(0:1040,9),HLONG(0:1024),PLONG(0:1040,9),
|
|---|
| 45 | * SPLONG(0:1040,9),THSTEP,THSTPI
|
|---|
| 46 | INTEGER NSTEP
|
|---|
| 47 | LOGICAL LLONGI,FLGFIT
|
|---|
| 48 | *KEEP,MAGANG.
|
|---|
| 49 | COMMON /MAGANG/ ARRANG,ARRANR,COSANG,SINANG
|
|---|
| 50 | DOUBLE PRECISION ARRANG,ARRANR,COSANG,SINANG
|
|---|
| 51 | *KEEP,MAGNET.
|
|---|
| 52 | COMMON /MAGNET/ BX,BZ,BVAL,BNORMC,BNORM,COSB,SINB,BLIMIT
|
|---|
| 53 | DOUBLE PRECISION BX,BZ,BVAL,BNORMC
|
|---|
| 54 | REAL BNORM,COSB,SINB,BLIMIT
|
|---|
| 55 | *KEEP,NKGI.
|
|---|
| 56 | COMMON /NKGI/ SEL,SELLG,STH,ZEL,ZELLG,ZSL,DIST,
|
|---|
| 57 | * DISX,DISY,DISXY,DISYX,DLAX,DLAY,DLAXY,DLAYX,
|
|---|
| 58 | * OBSATI,RADNKG,RMOL,TLEV,TLEVCM,IALT
|
|---|
| 59 | DOUBLE PRECISION SEL(10),SELLG(10),STH(10),ZEL(10),ZELLG(10),
|
|---|
| 60 | * ZSL(10),DIST(10),
|
|---|
| 61 | * DISX(-10:10),DISY(-10:10),
|
|---|
| 62 | * DISXY(-10:10,2),DISYX(-10:10,2),
|
|---|
| 63 | * DLAX (-10:10,2),DLAY (-10:10,2),
|
|---|
| 64 | * DLAXY(-10:10,2),DLAYX(-10:10,2),
|
|---|
| 65 | * OBSATI(2),RADNKG,RMOL(2),TLEV(10),TLEVCM(10)
|
|---|
| 66 | INTEGER IALT(2)
|
|---|
| 67 | *KEEP,OBSPAR.
|
|---|
| 68 | COMMON /OBSPAR/ OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
|
|---|
| 69 | * THETPR,PHIPR,NOBSLV
|
|---|
| 70 | DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
|
|---|
| 71 | * THETAP,THETPR(2),PHIP,PHIPR(2)
|
|---|
| 72 | INTEGER NOBSLV
|
|---|
| 73 | *KEEP,PARPAR.
|
|---|
| 74 | COMMON /PARPAR/ CURPAR,SECPAR,PRMPAR,OUTPAR,C,
|
|---|
| 75 | * E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
|
|---|
| 76 | DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
|
|---|
| 77 | * C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
|
|---|
| 78 | INTEGER ITYPE,LEVL
|
|---|
| 79 | *KEEP,PARPAE.
|
|---|
| 80 | DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
|
|---|
| 81 | EQUIVALENCE (CURPAR(2),GAMMA), (CURPAR(3),COSTHE),
|
|---|
| 82 | * (CURPAR(4), PHI ), (CURPAR(5), H ),
|
|---|
| 83 | * (CURPAR(6), T ), (CURPAR(7), X ),
|
|---|
| 84 | * (CURPAR(8), Y ), (CURPAR(9), CHI ),
|
|---|
| 85 | * (CURPAR(10),BETA), (CURPAR(11),GCM ),
|
|---|
| 86 | * (CURPAR(12),ECM )
|
|---|
| 87 | *KEEP,PRIMSP.
|
|---|
| 88 | COMMON /PRIMSP/ PSLOPE,LLIMIT,ULIMIT,LL,UL,SLEX,ISPEC
|
|---|
| 89 | DOUBLE PRECISION PSLOPE,LLIMIT,ULIMIT,LL,UL,SLEX
|
|---|
| 90 | INTEGER ISPEC
|
|---|
| 91 | *KEEP,RANDPA.
|
|---|
| 92 | COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR
|
|---|
| 93 | DOUBLE PRECISION FAC,U1,U2
|
|---|
| 94 | REAL RD(3000)
|
|---|
| 95 | INTEGER ISEED(103,10),NSEQ
|
|---|
| 96 | LOGICAL KNOR
|
|---|
| 97 | *KEEP,REJECT.
|
|---|
| 98 | COMMON /REJECT/ AVNREJ,
|
|---|
| 99 | * ALTMIN,ANEXP,THICKA,THICKD,CUTLN,EONCUT,
|
|---|
| 100 | * FNPRIM
|
|---|
| 101 | DOUBLE PRECISION AVNREJ(10)
|
|---|
| 102 | REAL ALTMIN(10),ANEXP(10),THICKA(10),THICKD(10),
|
|---|
| 103 | * CUTLN,EONCUT
|
|---|
| 104 | LOGICAL FNPRIM
|
|---|
| 105 | *KEEP,RUNPAR.
|
|---|
| 106 | COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
|
|---|
| 107 | * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
|
|---|
| 108 | * MONIOU,MDEBUG,NUCNUC,
|
|---|
| 109 | * CETAPE,
|
|---|
| 110 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
|---|
| 111 | * N1STTR,MDBASE,
|
|---|
| 112 | * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
|---|
| 113 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
|---|
| 114 | * ,GHEISH,GHESIG
|
|---|
| 115 | COMMON /RUNPAC/ DSN,HOST,USER
|
|---|
| 116 | DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
|
|---|
| 117 | REAL STEPFC
|
|---|
| 118 | INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
|
|---|
| 119 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
|---|
| 120 | * N1STTR,MDBASE
|
|---|
| 121 | INTEGER CETAPE
|
|---|
| 122 | CHARACTER*79 DSN
|
|---|
| 123 | CHARACTER*20 HOST,USER
|
|---|
| 124 |
|
|---|
| 125 | LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
|---|
| 126 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
|---|
| 127 | * ,GHEISH,GHESIG
|
|---|
| 128 | *KEEP,STACKF.
|
|---|
| 129 | COMMON /STACKF/ STACK,STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
|
|---|
| 130 | INTEGER MAXSTK
|
|---|
| 131 | PARAMETER (MAXSTK = 12*340*2)
|
|---|
| 132 | DOUBLE PRECISION STACK(MAXSTK)
|
|---|
| 133 | INTEGER STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
|
|---|
| 134 | *KEEP,VERS.
|
|---|
| 135 | COMMON /VERS/ VERNUM,MVDATE,VERDAT
|
|---|
| 136 | DOUBLE PRECISION VERNUM
|
|---|
| 137 | INTEGER MVDATE
|
|---|
| 138 | CHARACTER*18 VERDAT
|
|---|
| 139 | *KEEP,VENUS.
|
|---|
| 140 | COMMON /VENUS/ ISH0,IVERVN,MTAR99,FVENUS,FVENSG
|
|---|
| 141 | INTEGER ISH0,IVERVN,MTAR99
|
|---|
| 142 | LOGICAL FVENUS,FVENSG
|
|---|
| 143 | *KEEP,CEREN1.
|
|---|
| 144 | COMMON /CEREN1/ CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD,
|
|---|
| 145 | * CERSIZ,LCERFI
|
|---|
| 146 | DOUBLE PRECISION CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD
|
|---|
| 147 | REAL CERSIZ
|
|---|
| 148 | LOGICAL LCERFI
|
|---|
| 149 | *KEEP,CEREN2.
|
|---|
| 150 | COMMON /CEREN2/ PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
|
|---|
| 151 | * DCERX,DCERY,ACERX,ACERY,
|
|---|
| 152 | * XCMAX,YCMAX,EPSX,EPSY,
|
|---|
| 153 | * DCERXI,DCERYI,FCERX,FCERY,
|
|---|
| 154 | * XSCATT,YSCATT,CERXOS,CERYOS,
|
|---|
| 155 | * NCERX,NCERY,ICERML
|
|---|
| 156 | REAL PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
|
|---|
| 157 | * DCERX,DCERY,ACERX,ACERY,
|
|---|
| 158 | * XCMAX,YCMAX,EPSX,EPSY,
|
|---|
| 159 | * DCERXI,DCERYI,FCERX,FCERY,
|
|---|
| 160 | * XSCATT,YSCATT,CERXOS(20),CERYOS(20)
|
|---|
| 161 | INTEGER NCERX,NCERY,ICERML
|
|---|
| 162 | *KEND.
|
|---|
| 163 |
|
|---|
| 164 | DOUBLE PRECISION EFRAC,HEIGH,H0,OOO,THICK
|
|---|
| 165 | REAL VERVEN
|
|---|
| 166 | INTEGER I,IBL,IDPM,ILONG,ISO,J,L
|
|---|
| 167 | LOGICAL LTHIN
|
|---|
| 168 | EXTERNAL HEIGH,THICK
|
|---|
| 169 | CHARACTER*1 MARK
|
|---|
| 170 | CHARACTER*9 LSTDSN
|
|---|
| 171 | C-----------------------------------------------------------------------
|
|---|
| 172 |
|
|---|
| 173 | WRITE(MONIOU,504)
|
|---|
| 174 | 504 FORMAT(//' ',10('='),' SHOWER PARAMETERS ', 50('=') )
|
|---|
| 175 |
|
|---|
| 176 | C WRITE ENERGY SPECTRUM TO HEADER
|
|---|
| 177 | RUNH(16) = PSLOPE
|
|---|
| 178 | RUNH(17) = LLIMIT
|
|---|
| 179 | RUNH(18) = ULIMIT
|
|---|
| 180 |
|
|---|
| 181 | EVTH(58) = PSLOPE
|
|---|
| 182 | EVTH(59) = LLIMIT
|
|---|
| 183 | EVTH(60) = ULIMIT
|
|---|
| 184 |
|
|---|
| 185 | IF ( PRMPAR(1) .GE. 6000.D0 .OR. PRMPAR(1) .LE. 0.D0 ) THEN
|
|---|
| 186 | WRITE(MONIOU,*)'INCORRECT SELECTION OF PRIMARY PARTICLE TYPE = '
|
|---|
| 187 | * ,INT(PRMPAR(1))
|
|---|
| 188 | WRITE(MONIOU,*)'PLEASE READ THE MANUALS'
|
|---|
| 189 | STOP
|
|---|
| 190 | ENDIF
|
|---|
| 191 | C CHECK WETHER NUCLEUS IS A SINGLE NUCLEON
|
|---|
| 192 | IF (PRMPAR(1) .EQ. 100.D0 ) PRMPAR(1) = 13.D0
|
|---|
| 193 | IF (PRMPAR(1) .EQ. 101.D0 ) PRMPAR(1) = 14.D0
|
|---|
| 194 | WRITE(MONIOU,*)'PRIMARY PARTICLE IDENTIFICATION IS ',
|
|---|
| 195 | * NINT(PRMPAR(1))
|
|---|
| 196 | C CHECK RECOMMENDED ENERGY RANGE
|
|---|
| 197 | IF ( FVENUS .AND.
|
|---|
| 198 | * ULIMIT.GT.2.D7 .AND. PRMPAR(1).GE.8.D0 ) THEN
|
|---|
| 199 | WRITE(MONIOU,502) ULIMIT
|
|---|
| 200 | 502 FORMAT(' INTERACTION MODEL DOUBTFUL FOR THE SELECTED PRIMARY ',
|
|---|
| 201 | * 'ENERGY OF ',E10.3,' GEV'/' PLEASE READ THE MANUALS')
|
|---|
| 202 | STOP
|
|---|
| 203 | ENDIF
|
|---|
| 204 |
|
|---|
| 205 |
|
|---|
| 206 |
|
|---|
| 207 |
|
|---|
| 208 | c> *** modified by fs (22/09/98) *******************************
|
|---|
| 209 |
|
|---|
| 210 |
|
|---|
| 211 | c IF ( PRMPAR(1) .GT. 101.D0 ) THEN
|
|---|
| 212 | c IF ( GHEISH ) THEN
|
|---|
| 213 | cC GHEISHA CAN TREAT ONLY DEUTERONS, TRITONS, AND ALPHA PARTICLES
|
|---|
| 214 | c IF ( PRMPAR(1) .NE. 201.D0 .AND. PRMPAR(1) .NE. 301.D0
|
|---|
| 215 | c * .AND. PRMPAR(1) .NE. 402.D0 ) THEN
|
|---|
| 216 | c IF ( LLIMIT .LT. HILOELB * INT(PRMPAR(1)/100.D0) ) THEN
|
|---|
| 217 | c WRITE(MONIOU,503) INT(PRMPAR(1)/100.D0),LLIMIT
|
|---|
| 218 | c STOP
|
|---|
| 219 | c ENDIF
|
|---|
| 220 | c ENDIF
|
|---|
| 221 | c ELSE
|
|---|
| 222 | c IF ( LLIMIT .LT. HILOELB * INT(PRMPAR(1)/100.D0) ) THEN
|
|---|
| 223 | c WRITE(MONIOU,503) INT(PRMPAR(1)/100.D0),LLIMIT
|
|---|
| 224 | c 503 FORMAT(' NUCLEUS WITH A =',I2,' AND PRIMARY ENERGY =',
|
|---|
| 225 | c * 1PE10.3,' GEV TOO LOW FOR HIGH ENERGY INTERACTION MODEL'/
|
|---|
| 226 | c * ' AND CANNOT BE TREATED BY LOW ENERGY INTERACTION MODEL'/
|
|---|
| 227 | c * ' PLEASE READ THE MANUALS')
|
|---|
| 228 | c STOP
|
|---|
| 229 | c ENDIF
|
|---|
| 230 | c ENDIF
|
|---|
| 231 | c ENDIF
|
|---|
| 232 |
|
|---|
| 233 |
|
|---|
| 234 | c> *** end of modification ****************************************
|
|---|
| 235 |
|
|---|
| 236 | C DEFINE ENERGY RANGE AND ENERGY SPECTRUM OF PRIMARY
|
|---|
| 237 | IF ( LLIMIT .EQ. ULIMIT ) THEN
|
|---|
| 238 | ISPEC = 0
|
|---|
| 239 | WRITE(MONIOU,506) LLIMIT
|
|---|
| 240 | 506 FORMAT(' PRIMARY ENERGY IS FIXED AT ',1PE10.3,
|
|---|
| 241 | * ' GEV' )
|
|---|
| 242 | ELSE
|
|---|
| 243 | ISPEC = 1
|
|---|
| 244 | WRITE(MONIOU,505) PSLOPE,LLIMIT,ULIMIT
|
|---|
| 245 | 505 FORMAT(' PRIMARY ENERGY IS TAKEN FROM SPECTRUM VIA MONTE CARLO'/
|
|---|
| 246 | * 5X,' SLOPE OF PRIMARY SPECTRUM = ',1P,E10.3/
|
|---|
| 247 | * 5X,' LOWER LIMIT CUT-OFF FOR PRIMARY SPECTRUM = ',E10.3,' GEV'/
|
|---|
| 248 | * 5X,' UPPER LIMIT CUT-OFF FOR PRIMARY SPECTRUM = ',E10.3,' GEV'/)
|
|---|
| 249 | IF ( PSLOPE .NE. -1.D0 ) THEN
|
|---|
| 250 | LL = LLIMIT ** (PSLOPE + 1.D0)
|
|---|
| 251 | UL = ULIMIT ** (PSLOPE + 1.D0)
|
|---|
| 252 | SLEX = 1.D0 / (PSLOPE + 1.D0)
|
|---|
| 253 | ELSE
|
|---|
| 254 | LL = ULIMIT / LLIMIT
|
|---|
| 255 | ENDIF
|
|---|
| 256 | ENDIF
|
|---|
| 257 |
|
|---|
| 258 | C FIRST INTERACTION TARGET FIXED ?
|
|---|
| 259 | IF ( N1STTR .EQ. 1 ) THEN
|
|---|
| 260 | WRITE(MONIOU,508) 'NITROGEN'
|
|---|
| 261 | 508 FORMAT(' TARGET OF FIRST INTERACTION IS FIXED TO ',A8)
|
|---|
| 262 | ELSEIF ( N1STTR .EQ. 2 ) THEN
|
|---|
| 263 | WRITE(MONIOU,508) 'OXYGEN '
|
|---|
| 264 | ELSEIF ( N1STTR .EQ. 3 ) THEN
|
|---|
| 265 | WRITE(MONIOU,508) 'ARGON '
|
|---|
| 266 | ELSE
|
|---|
| 267 | N1STTR = 0
|
|---|
| 268 | WRITE(MONIOU,*)'TARGET OF FIRST INTERACTION IS CHOSEN RANDOMLY'
|
|---|
| 269 | ENDIF
|
|---|
| 270 |
|
|---|
| 271 | C CHECK ANGULAR SETTINGS
|
|---|
| 272 | IF ( THETPR(1) .LT. 0.D0 ) THEN
|
|---|
| 273 | WRITE(MONIOU,*)'UNALLOWED CHOICE OF THETPR = ',SNGL(THETPR(1)),
|
|---|
| 274 | * ' DEGREES'
|
|---|
| 275 | WRITE(MONIOU,*)'PLEASE READ THE MANUALS'
|
|---|
| 276 | STOP
|
|---|
| 277 | ENDIF
|
|---|
| 278 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 279 | c> IF ( THETPR(2) .GT. 70.D0 ) THEN
|
|---|
| 280 | c> WRITE(MONIOU,*)'UNALLOWED CHOICE OF THETPR = ',SNGL(THETPR(2)),
|
|---|
| 281 | c> * ' DEGREES'
|
|---|
| 282 | c> WRITE(MONIOU,*)'PLEASE READ THE MANUALS'
|
|---|
| 283 | c> STOP
|
|---|
| 284 | c> ELSEIF ( THETPR(2) .GT. 45.D0 ) THEN
|
|---|
| 285 | c> WRITE(MONIOU,*)'UNALLOWED CHOICE OF THETPR = ',SNGL(THETPR(2)),
|
|---|
| 286 | c> * ' DEGREES'
|
|---|
| 287 | c> WRITE(MONIOU,*)'#########################################'
|
|---|
| 288 | c> WRITE(MONIOU,*)'# IN DOUBTFUL CASES CONTACT THE AUTHORS #'
|
|---|
| 289 | c> WRITE(MONIOU,*)'#########################################'
|
|---|
| 290 | c> STOP
|
|---|
| 291 | c> ENDIF
|
|---|
| 292 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 293 | C INCIDENCE ANGLE FIXED ?
|
|---|
| 294 | IF ( THETPR(1) .EQ. THETPR(2) .AND. PHIPR(1) .EQ. PHIPR(2) ) THEN
|
|---|
| 295 | FIXINC = .TRUE.
|
|---|
| 296 | WRITE(MONIOU,517) THETPR(1),PHIPR(1)
|
|---|
| 297 | 517 FORMAT(' THETA OF INCIDENCE IS FIXED TO ',F10.2,' DEGREES'/
|
|---|
| 298 | * ' PHI OF INCIDENCE IS FIXED TO ',F10.2,' DEGREES')
|
|---|
| 299 | ELSE
|
|---|
| 300 | FIXINC = .FALSE.
|
|---|
| 301 | WRITE(MONIOU,527) THETPR,PHIPR
|
|---|
| 302 | 527 FORMAT(' THETA OF INCIDENCE CHOSEN FROM ',F10.2,'...',F10.2,
|
|---|
| 303 | * ' DEGREES'/
|
|---|
| 304 | * ' PHI OF INCIDENCE CHOSEN FROM ',F10.2,'...',F10.2,
|
|---|
| 305 | * ' DEGREES')
|
|---|
| 306 | ENDIF
|
|---|
| 307 | EVTH(81) = THETPR(1)
|
|---|
| 308 | EVTH(82) = THETPR(2)
|
|---|
| 309 | EVTH(83) = PHIPR(1)
|
|---|
| 310 | EVTH(84) = PHIPR(2)
|
|---|
| 311 | THETPR(1) = THETPR(1)*PI/180.D0
|
|---|
| 312 | THETPR(2) = THETPR(2)*PI/180.D0
|
|---|
| 313 | PHIPR(1) = PHIPR(1) *PI/180.D0
|
|---|
| 314 | PHIPR(2) = PHIPR(2) *PI/180.D0
|
|---|
| 315 |
|
|---|
| 316 | C-----------------------------------------------------------------------
|
|---|
| 317 | C PRMPAR, OBSLEV, NOBSLV
|
|---|
| 318 | PRMPAR(2) = 0.D0
|
|---|
| 319 | PRMPAR(6) = 0.D0
|
|---|
| 320 | PRMPAR(7) = 0.D0
|
|---|
| 321 | PRMPAR(8) = 0.D0
|
|---|
| 322 |
|
|---|
| 323 | C ORDERING OF OBSERVATION LEVELS FROM TOP TO BOTTOM
|
|---|
| 324 | IF ( NOBSLV .GT. 1 ) THEN
|
|---|
| 325 | 215 CONTINUE
|
|---|
| 326 | DO 11 I = 2,NOBSLV
|
|---|
| 327 | IF ( OBSLEV(I) .GT. OBSLEV(I-1) ) THEN
|
|---|
| 328 | OOO = OBSLEV(I)
|
|---|
| 329 | OBSLEV(I) = OBSLEV(I-1)
|
|---|
| 330 | OBSLEV(I-1) = OOO
|
|---|
| 331 | GOTO 215
|
|---|
| 332 | ENDIF
|
|---|
| 333 | 11 CONTINUE
|
|---|
| 334 | ENDIF
|
|---|
| 335 | C CHECK WETHER OBSERVATION LEVELS ARE IN ALLOWED RANGE
|
|---|
| 336 | DO 12 I = 1,NOBSLV
|
|---|
| 337 | IF ( OBSLEV(I) .GE. HEIGH(0.D0) ) THEN
|
|---|
| 338 | WRITE(MONIOU,120)I,OBSLEV(I),HEIGH(0.D0)
|
|---|
| 339 | 120 FORMAT(' UNALLOWED CHOICE OF OBSLEV '/' OBSERVATION LEVEL ',
|
|---|
| 340 | * I2,' IS AT ',F12.3,' CM, WHICH IS ABOVE ',
|
|---|
| 341 | * F12.3,' CM'/' PLEASE READ THE MANUALS')
|
|---|
| 342 | STOP
|
|---|
| 343 | ENDIF
|
|---|
| 344 | IF ( OBSLEV(I) .LE. -1.D5 ) THEN
|
|---|
| 345 | WRITE(MONIOU,121)I,OBSLEV(I)
|
|---|
| 346 | 121 FORMAT(' UNALLOWED CHOICE OF OBSLEV '/' OBSERVATION LEVEL ',
|
|---|
| 347 | * I2,' IS AT ',F12.3,' CM, WHICH IS BELOW ',
|
|---|
| 348 | * '-1.D5 CM'/' PLEASE READ THE MANUALS')
|
|---|
| 349 | STOP
|
|---|
| 350 | ENDIF
|
|---|
| 351 | THCKOB(I) = THICK(OBSLEV(I))
|
|---|
| 352 | 12 CONTINUE
|
|---|
| 353 |
|
|---|
| 354 | C WRITE OBSERVATION LEVELS TO HEADER (IN CM)
|
|---|
| 355 | RUNH(5) = REAL(NOBSLV)
|
|---|
| 356 | EVTH(47) = REAL(NOBSLV)
|
|---|
| 357 | DO 114 I = 1,NOBSLV
|
|---|
| 358 | RUNH(5+I) = OBSLEV(I)
|
|---|
| 359 | EVTH(47+I) = OBSLEV(I)
|
|---|
| 360 | 114 CONTINUE
|
|---|
| 361 |
|
|---|
| 362 | C FIRST INTERACTION HEIGHT FIXED ?
|
|---|
| 363 | IF ( FIX1I ) THEN
|
|---|
| 364 | IF ( FIXHEI .GE. HEIGH(0.D0) ) THEN
|
|---|
| 365 | WRITE(MONIOU,122)FIXHEI,HEIGH(0.D0)
|
|---|
| 366 | 122 FORMAT(' UNALLOWED CHOICE OF FIXHEI '/' FIRST INTERACTION ',
|
|---|
| 367 | * 'IS FIXED AT ',F12.3,' CM, WHICH IS ABOVE ',
|
|---|
| 368 | * F12.3,' CM'/' PLEASE READ THE MANUALS')
|
|---|
| 369 | STOP
|
|---|
| 370 | ENDIF
|
|---|
| 371 | IF ( FIXHEI .LE. OBSLEV(NOBSLV) ) THEN
|
|---|
| 372 | WRITE(MONIOU,123)FIXHEI,OBSLEV(NOBSLV)
|
|---|
| 373 | 123 FORMAT(' UNALLOWED CHOICE OF FIXHEI '/' FIRST INTERACTION ',
|
|---|
| 374 | * 'IS FIXED AT ',F12.3,' CM, '/' WHICH IS BELOW ',
|
|---|
| 375 | * 'LOWEST OBSERVATION LEVEL AT ',F12.3,' CM'
|
|---|
| 376 | * /' PLEASE READ THE MANUALS')
|
|---|
| 377 | STOP
|
|---|
| 378 | ENDIF
|
|---|
| 379 | WRITE(MONIOU,507) FIXHEI
|
|---|
| 380 | 507 FORMAT(' HEIGHT OF FIRST INTERACTION IS FIXED TO ',1P,E10.2,
|
|---|
| 381 | * ' CM')
|
|---|
| 382 | IF ( N1STTR .GE. 1 .AND. N1STTR .LE. 3 ) THEN
|
|---|
| 383 | IF ( PRMPAR(1) .LE. 3.D0 ) THEN
|
|---|
| 384 | WRITE(MONIOU,516) INT(PRMPAR(1))
|
|---|
| 385 | 516 FORMAT(' TARGET OF FIRST INTERACTION CANNOT BE FIXED FOR ',
|
|---|
| 386 | * 'PRIMARY TYPE ',I5/' PLEASE READ THE MANUALS')
|
|---|
| 387 | STOP
|
|---|
| 388 | ELSEIF ( N1STTR .EQ. 1 ) THEN
|
|---|
| 389 | WRITE(MONIOU,*)'TARGET OF FIRST INTERACTION IS NITROGEN'
|
|---|
| 390 | ELSEIF ( N1STTR .EQ. 2 ) THEN
|
|---|
| 391 | WRITE(MONIOU,*)'TARGET OF FIRST INTERACTION IS OXYGEN'
|
|---|
| 392 | ELSEIF ( N1STTR .EQ. 3 ) THEN
|
|---|
| 393 | WRITE(MONIOU,*)'TARGET OF FIRST INTERACTION IS ARGON'
|
|---|
| 394 | ENDIF
|
|---|
| 395 | ELSE
|
|---|
| 396 | WRITE(MONIOU,*)
|
|---|
| 397 | * 'TARGET OF FIRST INTERACTION IS CHOSEN AT RANDOM'
|
|---|
| 398 | ENDIF
|
|---|
| 399 | ELSE
|
|---|
| 400 | FIXHEI = 0.D0
|
|---|
| 401 | WRITE(MONIOU,*) 'HEIGHT OF FIRST INTERACTION IS CHOSEN RANDOMLY'
|
|---|
| 402 | ENDIF
|
|---|
| 403 |
|
|---|
| 404 | C STARTING ALTITUDE WITHIN ATMOSPHERE?
|
|---|
| 405 | IF ( THICK0 .LT. 0.D0 ) THEN
|
|---|
| 406 | WRITE(MONIOU,130)THICK0
|
|---|
| 407 | 130 FORMAT(' UNALLOWED STARTING ALTITUDE WITH NEGATIVE MASS OVERLAY'
|
|---|
| 408 | * ,E12.3/' PLEASE READ THE MANUALS')
|
|---|
| 409 | STOP
|
|---|
| 410 | ENDIF
|
|---|
| 411 | IF ( THICK0 .GE. THCKOB(NOBSLV) ) THEN
|
|---|
| 412 | WRITE(MONIOU,131) THICK0
|
|---|
| 413 | 131 FORMAT(' UNALLOWED STARTING ALTITUDE AT ',F12.3,' G/CM**2',
|
|---|
| 414 | * ' WHICH IS BELOW LOWEST OBSERVATION LEVEL'/
|
|---|
| 415 | * ' PLEASE READ THE MANUALS')
|
|---|
| 416 | STOP
|
|---|
| 417 | ENDIF
|
|---|
| 418 | H0 = HEIGH(THICK0)
|
|---|
| 419 | IF ( THICK0 .EQ. 0.D0 ) THEN
|
|---|
| 420 | WRITE(MONIOU,518) H0, THICK0
|
|---|
| 421 | WRITE(MONIOU,*)' WHICH IS AT TOP OF ATMOSPHERE'
|
|---|
| 422 | ELSE
|
|---|
| 423 | WRITE(MONIOU,518) H0, THICK0
|
|---|
| 424 | ENDIF
|
|---|
| 425 | 518 FORMAT(' STARTING ALTITUDE AT ',1P,F13.2,' CM (=',
|
|---|
| 426 | * E7.1,' G/CM**2)')
|
|---|
| 427 | WRITE(MONIOU,203) (OBSLEV(I),THCKOB(I),I=1,NOBSLV)
|
|---|
| 428 | 203 FORMAT(/' OBSERVATION LEVELS IN CM AND IN G/CM**2 ',
|
|---|
| 429 | * 1P /(5X, 2E20.8 /))
|
|---|
| 430 |
|
|---|
| 431 | C LONGITUDINAL SHOWER DEVELOPMENT
|
|---|
| 432 | IF ( LLONGI ) THEN
|
|---|
| 433 | THSTEP = NINT(THSTEP)
|
|---|
| 434 | THSTEP = MAX(THSTEP,1.D0)
|
|---|
| 435 | THSTEP = MIN(THSTEP,1040.D0)
|
|---|
| 436 | THSTPI = 1.D0/THSTEP
|
|---|
| 437 | NSTEP = INT(THCKOB(NOBSLV)*THSTPI)
|
|---|
| 438 | IF ( NSTEP .GE. 1040 ) THEN
|
|---|
| 439 | NSTEP = 1040
|
|---|
| 440 | THSTEP = THCKOB(NOBSLV)/NSTEP
|
|---|
| 441 | WRITE(MONIOU,*)'LONGITUDINAL SHOWER SAMPLING MODIFIED'
|
|---|
| 442 | ENDIF
|
|---|
| 443 | WRITE(MONIOU,925) NSTEP+1,THSTEP
|
|---|
| 444 | 925 FORMAT(/' LONGITUDINAL SHOWER DEVELOPMENT:'/
|
|---|
| 445 | * ' SHOWER IS SAMPLED IN ',I4,
|
|---|
| 446 | * ' STEPS OF ',F6.1,' G/CM**2')
|
|---|
| 447 | C GET HEIGHT VALUES IN CM FOR USE IN EGS
|
|---|
| 448 | DO 478 J = 0,NSTEP
|
|---|
| 449 | HLONG(J) = HEIGH(J*THSTEP)
|
|---|
| 450 | 478 CONTINUE
|
|---|
| 451 | IF ( FLGFIT ) THEN
|
|---|
| 452 | WRITE(MONIOU,*)
|
|---|
| 453 | * ' FIT TO CHARGED PARTICLE LONG. DISTRIBUTION ENABLED'
|
|---|
| 454 | ELSE
|
|---|
| 455 | WRITE(MONIOU,*)
|
|---|
| 456 | * ' FIT TO CHARGED PARTICLE LONG. DISTRIBUTION DISABLED'
|
|---|
| 457 | ENDIF
|
|---|
| 458 | WRITE(MONIOU,*)
|
|---|
| 459 | ENDIF
|
|---|
| 460 |
|
|---|
| 461 | C-----------------------------------------------------------------------
|
|---|
| 462 | C CHECK INPUT OF ENERGY CUTS
|
|---|
| 463 | IF ( GHEISH .AND. ELCUT(1) .LT. 0.05D0 ) THEN
|
|---|
| 464 | WRITE(MONIOU,*)'ELCUT(1) SELECTED INCORRECT TO ',ELCUT(1),' GEV'
|
|---|
| 465 | WRITE(MONIOU,*)'PLEASE READ THE MANUALS '
|
|---|
| 466 | STOP
|
|---|
| 467 | ELSEIF ( .NOT.GHEISH .AND. ELCUT(1) .LT. 0.3D0 ) THEN
|
|---|
| 468 | WRITE(MONIOU,*)'ELCUT(1) SELECTED INCORRECT TO ',ELCUT(1),' GEV'
|
|---|
| 469 | WRITE(MONIOU,*)'PLEASE READ THE MANUALS '
|
|---|
| 470 | STOP
|
|---|
| 471 | ENDIF
|
|---|
| 472 | IF ( ELCUT(2) .LT. 0.05D0 ) THEN
|
|---|
| 473 | WRITE(MONIOU,*)'ELCUT(2) SELECTED INCORRECT TO ',ELCUT(2),' GEV'
|
|---|
| 474 | WRITE(MONIOU,*)'PLEASE READ THE MANUALS '
|
|---|
| 475 | STOP
|
|---|
| 476 | ENDIF
|
|---|
| 477 | IF ( ELCUT(3) .LT. 0.003D0 ) THEN
|
|---|
| 478 | WRITE(MONIOU,*)'ELCUT(3) SELECTED INCORRECT TO ',ELCUT(3),' GEV'
|
|---|
| 479 | WRITE(MONIOU,*)'PLEASE READ THE MANUALS '
|
|---|
| 480 | STOP
|
|---|
| 481 | ENDIF
|
|---|
| 482 | IF ( ELCUT(4) .LT. 0.003D0 ) THEN
|
|---|
| 483 | WRITE(MONIOU,*)'ELCUT(4) SELECTED INCORRECT TO ',ELCUT(4),' GEV'
|
|---|
| 484 | WRITE(MONIOU,*)'PLEASE READ THE MANUALS '
|
|---|
| 485 | STOP
|
|---|
| 486 | ENDIF
|
|---|
| 487 | WRITE(MONIOU,703) ECTMAP,ELCUT
|
|---|
| 488 | 703 FORMAT (' PARTICLES WITH LORENTZ FACTOR LARGER THAN',1P,E15.4,
|
|---|
| 489 | * ' ARE PRINTED OUT'/' SHOWER PARTICLES ENERGY CUT :'/
|
|---|
| 490 | * ' FOR HADRONS : ',E15.4,' GEV'/
|
|---|
| 491 | * ' FOR MUONS : ',E15.4,' GEV'/
|
|---|
| 492 | * ' FOR ELECTRONS : ',E15.4,' GEV'/
|
|---|
| 493 | * ' FOR PHOTONS : ',E15.4,' GEV'//)
|
|---|
| 494 |
|
|---|
| 495 | DO 774 I = 1,4
|
|---|
| 496 | RUNH(20+I) = ELCUT(I)
|
|---|
| 497 | EVTH(60+I) = ELCUT(I)
|
|---|
| 498 | 774 CONTINUE
|
|---|
| 499 |
|
|---|
| 500 | C-----------------------------------------------------------------------
|
|---|
| 501 | C PARAMETERS OF EARTH MAGNETIC FIELD OF MIDDLE EUROPE
|
|---|
| 502 | C +X DIRECTION IS NORTH, +Y DIRECTION IS EAST, +Z DIRECTION IS DOWN
|
|---|
| 503 | BVAL = SQRT( BX**2 + BZ**2 )
|
|---|
| 504 | C BNORM HAS DIMENSIONS OF MEV/CM
|
|---|
| 505 | BNORM = BVAL * C(25) * 1.D-16
|
|---|
| 506 | C BNORMC HAS DIMENSIONS OF GEV/CM
|
|---|
| 507 | BNORMC = BNORM * 1.D-3
|
|---|
| 508 | SINB = BZ / BVAL
|
|---|
| 509 | COSB = BX / BVAL
|
|---|
| 510 | WRITE(MONIOU,*)'EARTH MAGNETIC FIELD STRENGTH IS ',SNGL(BVAL),
|
|---|
| 511 | * ' MICROTESLA'
|
|---|
| 512 | WRITE(MONIOU,*)' WITH INCLINATION ANGLE ',
|
|---|
| 513 | * SNGL(ASIN(SINB)*180./PI),' DEGREES'
|
|---|
| 514 | IF ( BVAL .GE. 10000.D0 ) THEN
|
|---|
| 515 | WRITE(MONIOU,*)'YOU WANT TO MAGNETIZE THE GALAXY ?'
|
|---|
| 516 | WRITE(MONIOU,*)'PLEASE READ THE MANUALS !'
|
|---|
| 517 | STOP
|
|---|
| 518 | ENDIF
|
|---|
| 519 | C LIMITING FACTOR FOR STEP SIZE OF ELECTRON IN MAGNETIC FIELD
|
|---|
| 520 | BLIMIT = 0.2 / BNORM
|
|---|
| 521 | EVTH(71) = BX
|
|---|
| 522 | EVTH(72) = BZ
|
|---|
| 523 | C ANGLE BETWEEN ARRAY X-DIRECTION AND MAGNETIC NORD
|
|---|
| 524 | C POSITIV, IF X-DIRECTION OF ARRAY POINTS TO EASTERN DIRECTION
|
|---|
| 525 | ARRANR = ARRANG * PI / 180.D0
|
|---|
| 526 | COSANG = COS(ARRANR)
|
|---|
| 527 | SINANG = SIN(ARRANR)
|
|---|
| 528 | EVTH(93) = ARRANR
|
|---|
| 529 | IF ( ARRANG .NE. 0.D0 ) THEN
|
|---|
| 530 | WRITE(MONIOU,*)
|
|---|
| 531 | WRITE(MONIOU,*)'DETECTOR COORDINATE SYSTEM IS ROTATED AWAY ',
|
|---|
| 532 | * 'FROM NORTH BY ',SNGL(ARRANG),' DEGREES'
|
|---|
| 533 | ENDIF
|
|---|
| 534 |
|
|---|
| 535 | C-----------------------------------------------------------------------
|
|---|
| 536 | C DEFINE CERENKOV ARRAY
|
|---|
| 537 | NCERX = MAX( NCERX, 1 )
|
|---|
| 538 | NCERY = MAX( NCERY, 1 )
|
|---|
| 539 | ACERX = ABS(ACERX)
|
|---|
| 540 | ACERY = ABS(ACERY)
|
|---|
| 541 | DCERX = MAX( ABS(DCERX), 0.001 )
|
|---|
| 542 | DCERY = MAX( ABS(DCERY), 0.001 )
|
|---|
| 543 | XCMAX = (ACERX + (NCERX-1) * DCERX) * 0.5
|
|---|
| 544 | YCMAX = (ACERY + (NCERY-1) * DCERY) * 0.5
|
|---|
| 545 | DCERXI = 1./DCERX
|
|---|
| 546 | EPSX = ACERX * 0.5 * DCERXI
|
|---|
| 547 | DCERYI = 1./DCERY
|
|---|
| 548 | EPSY = ACERY * 0.5 * DCERYI
|
|---|
| 549 | IF ( MOD(NCERX,2) .EQ. 0 ) THEN
|
|---|
| 550 | FCERX = -0.5
|
|---|
| 551 | ELSE
|
|---|
| 552 | FCERX = 0.0
|
|---|
| 553 | ENDIF
|
|---|
| 554 | IF ( MOD(NCERY,2) .EQ. 0 ) THEN
|
|---|
| 555 | FCERY = -0.5
|
|---|
| 556 | ELSE
|
|---|
| 557 | FCERY = 0.0
|
|---|
| 558 | ENDIF
|
|---|
| 559 |
|
|---|
| 560 | WRITE(MONIOU,472)
|
|---|
| 561 | * ACERX*.01,ACERY*.01, DCERX*.01,DCERY*.01, NCERX,NCERY
|
|---|
| 562 | 472 FORMAT(/' CERENKOV ARRAY:'/
|
|---|
| 563 | * 5X,' CERENKOV STATIONS ARE ',F6.2,' X ',F6.2,' M**2 LARGE'/
|
|---|
| 564 | * 5X,' THE GRID SPACING IS ',F6.2,' AND ',F6.2,' M',/
|
|---|
| 565 | * 5X,' THERE ARE ',I3,' X ',I3,' STATIONS IN X/Y DIRECTIONS'/
|
|---|
| 566 | * 5X,' THE CERENKOV ARRAY IS CENTERED AROUND (0., 0.)'/)
|
|---|
| 567 | C CALCULATE CERENKOV YIELD FACTOR FROM WAVELENGTH BAND
|
|---|
| 568 | IF ( WAVLGL .LT. 100.D0 .OR. WAVLGU .GT. 700.D0
|
|---|
| 569 | * .OR. WAVLGL .GE. WAVLGU ) THEN
|
|---|
| 570 | WRITE(MONIOU,*)'CERENKOV WAVELENGTH BAND FROM ',SNGL(WAVLGL),
|
|---|
| 571 | * ' TO ',SNGL(WAVLGU),' NANOMETER'
|
|---|
| 572 | WRITE(MONIOU,*)' IS OUT OF VALIDITY RANGE'
|
|---|
| 573 | WRITE(MONIOU,*)'PLEASE READ THE MANUALS'
|
|---|
| 574 | STOP
|
|---|
| 575 | ENDIF
|
|---|
| 576 | WRITE(MONIOU,*)'CERENKOV WAVELENGTH BAND FROM ',SNGL(WAVLGL),
|
|---|
| 577 | * ' TO ',SNGL(WAVLGU),' NANOMETER'
|
|---|
| 578 | C WAVELENGTH IS CONVERTED FROM NM TO CM
|
|---|
| 579 | CYIELD = (1.D0/WAVLGL - 1.D0/WAVLGU) * 2.D7 * PI / C(50)
|
|---|
| 580 | C CALCULATE FACTOR FOR ETA DENSITY NORML.(ETA AT SEA LEVEL = 0.283D-3)
|
|---|
| 581 | ETADSN = 0.283D-3 * CATM(1) / BATM(1)
|
|---|
| 582 |
|
|---|
| 583 | IF ( CERSIZ .GT. 0. ) THEN
|
|---|
| 584 | WRITE(MONIOU,*)'CERENKOV BUNCH SIZE IS SET TO=',CERSIZ
|
|---|
| 585 | ELSE
|
|---|
| 586 | WRITE(MONIOU,*)'CERENKOV BUNCH SIZE IS CALCULATED FOR EACH ',
|
|---|
| 587 | * 'SHOWER'
|
|---|
| 588 | ENDIF
|
|---|
| 589 |
|
|---|
| 590 | IF ( LCERFI ) THEN
|
|---|
| 591 | WRITE(MONIOU,*)'CERENKOV PHOTONS ARE WRITTEN TO SEPARATE FILE'
|
|---|
| 592 | ELSE
|
|---|
| 593 | WRITE(MONIOU,*)'CERENKOV PHOTONS ARE WRITTEN TO PARTICLE ',
|
|---|
| 594 | * 'OUTPUT FILE'
|
|---|
| 595 | ENDIF
|
|---|
| 596 |
|
|---|
| 597 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 598 | c Next block of code has been modified, and is passed to MAIN
|
|---|
| 599 | c----------------------------------------------------------------------
|
|---|
| 600 | cC SCATTERING OF CENTER OF CHERENKOV ARRAY RELATIVE TO SHOWER AXIS
|
|---|
| 601 | c ICERML = MIN(MAX(ICERML,1),20)
|
|---|
| 602 | c XSCATT = ABS(XSCATT)
|
|---|
| 603 | c YSCATT = ABS(YSCATT)
|
|---|
| 604 | c IF ( ICERML .GE. 1 ) THEN
|
|---|
| 605 | c WRITE(MONIOU,5225)ICERML,XSCATT,YSCATT
|
|---|
| 606 | c 5225 FORMAT(' DEFINE MULTIPLE CERENKOV ARRAYS TO USE EACH',
|
|---|
| 607 | c * ' SHOWER SEVERAL TIMES'/ ' USE EACH EVENT ',I2,' TIMES'/
|
|---|
| 608 | c * ' THE EVENTS ARE SCATTERED QUASI RANDOMLY IN THE RANGE '/
|
|---|
| 609 | c * ' X = +- ',F10.0,' Y = +- ',F10.0)
|
|---|
| 610 | c DO 4438 I=1,ICERML
|
|---|
| 611 | c CALL SELCOR(CERXOS(I),CERYOS(I))
|
|---|
| 612 | c WRITE(MONIOU,4437) I,CERXOS(I),CERYOS(I)
|
|---|
| 613 | c 4437 FORMAT(' CORE OF EVENT ',I2,' AT ',2F12.2)
|
|---|
| 614 | c 4438 CONTINUE
|
|---|
| 615 | c XCMAX = XCMAX + XSCATT
|
|---|
| 616 | c YCMAX = YCMAX + YSCATT
|
|---|
| 617 | c ENDIF
|
|---|
| 618 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 619 |
|
|---|
| 620 | C STORE CERENKOV PARAMETERS IN EVENTHEADER
|
|---|
| 621 | EVTH(86) = NCERX
|
|---|
| 622 | EVTH(87) = NCERY
|
|---|
| 623 | EVTH(88) = DCERX
|
|---|
| 624 | EVTH(89) = DCERY
|
|---|
| 625 | EVTH(90) = ACERX
|
|---|
| 626 | EVTH(91) = ACERY
|
|---|
| 627 | IF ( LCERFI ) THEN
|
|---|
| 628 | EVTH(92) = 1.
|
|---|
| 629 | ELSE
|
|---|
| 630 | EVTH(92) = 0.
|
|---|
| 631 | ENDIF
|
|---|
| 632 | EVTH(96) = WAVLGL
|
|---|
| 633 | EVTH(97) = WAVLGU
|
|---|
| 634 |
|
|---|
| 635 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 636 | c Next block of code has been passed to MAIN
|
|---|
| 637 | c----------------------------------------------------------------------
|
|---|
| 638 | c EVTH(98) = FLOAT(ICERML)
|
|---|
| 639 | c DO 480 I=1,20
|
|---|
| 640 | c EVTH( 98+I) = CERXOS(I)
|
|---|
| 641 | c EVTH(118+I) = CERYOS(I)
|
|---|
| 642 | c 480 CONTINUE
|
|---|
| 643 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 644 |
|
|---|
| 645 | C-----------------------------------------------------------------------
|
|---|
| 646 | C FLAG FOR ADDITIONAL MUON INFORMATION
|
|---|
| 647 | IF ( FMUADD ) THEN
|
|---|
| 648 | WRITE(MONIOU,*)
|
|---|
| 649 | WRITE(MONIOU,*)'ADDITIONAL INFORMATION ON MUON ORIGIN IS',
|
|---|
| 650 | * ' WRITTEN TO PARTICLE TAPE'
|
|---|
| 651 | EVTH(94) = 1.
|
|---|
| 652 | ELSE
|
|---|
| 653 | EVTH(94) = 0.
|
|---|
| 654 | ENDIF
|
|---|
| 655 |
|
|---|
| 656 | C PRINTOUT OF INFORMATIONS FOR DEBUGGING
|
|---|
| 657 | IF ( DEBUG ) WRITE(MONIOU,484) MDEBUG
|
|---|
| 658 | 484 FORMAT(/' ATTENTION ! DEBUGGING IS ACTIVE'/
|
|---|
| 659 | * ' ====> DEBUG INFORMATION WRITTEN TO UNIT ',I3//)
|
|---|
| 660 |
|
|---|
| 661 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 662 | c Next block of code is obsolete.
|
|---|
| 663 | c Now it's used "jcio" routines (C)
|
|---|
| 664 | cC-----------------------------------------------------------------------
|
|---|
| 665 | cC OPEN OUTPUT DATA SET FOR RUN
|
|---|
| 666 | c IBL = INDEX(DSN,' ')
|
|---|
| 667 | c DSN(IBL:73) = 'DAT000000'
|
|---|
| 668 | c WRITE(DSN(IBL+3:IBL+8),'(I6)') NRRUN
|
|---|
| 669 | c DO 274 L = IBL+3,IBL+8
|
|---|
| 670 | c IF ( DSN(L:L) .EQ. ' ' ) DSN(L:L) = '0'
|
|---|
| 671 | c 274 CONTINUE
|
|---|
| 672 | cC OPEN DATASET FOR PARTICLE OUTPUT
|
|---|
| 673 | c OPEN(UNIT=PATAPE,FILE=DSN,STATUS='NEW',
|
|---|
| 674 | c * FORM='UNFORMATTED',ACCESS='SEQUENTIAL')
|
|---|
| 675 | c WRITE(MONIOU,579) DSN
|
|---|
| 676 | c 579 FORMAT(/' PARTICLE OUTPUT TO DIRECTORY : ',A79)
|
|---|
| 677 | cC WRITE RUNHEADER TO OUTPUT BUFFER
|
|---|
| 678 | c CALL TOBUF( RUNH,0 )
|
|---|
| 679 | c
|
|---|
| 680 | cC OPEN OUTPUT DATA SET FOR CERENKOV PHOTONS
|
|---|
| 681 | c IF ( LCERFI ) THEN
|
|---|
| 682 | c DSN(IBL:73) = 'CER000000'
|
|---|
| 683 | c WRITE(DSN(IBL+3:IBL+8),'(I6)') NRRUN
|
|---|
| 684 | c DO 249 L = IBL+3,IBL+8
|
|---|
| 685 | c IF (DSN(L:L) .EQ. ' ' ) DSN(L:L) = '0'
|
|---|
| 686 | c 249 CONTINUE
|
|---|
| 687 | c OPEN(UNIT=CETAPE,FILE=DSN,STATUS='NEW',
|
|---|
| 688 | c * FORM='UNFORMATTED',ACCESS='SEQUENTIAL')
|
|---|
| 689 | c WRITE(MONIOU,580) DSN
|
|---|
| 690 | c 580 FORMAT(' CERENKOV OUTPUT TO DIRECTORY : ',A79)
|
|---|
| 691 | c CALL TOBUFC( RUNH,0 )
|
|---|
| 692 | c ELSE
|
|---|
| 693 | c WRITE(MONIOU,580) DSN
|
|---|
| 694 | c ENDIF
|
|---|
| 695 | cC RESET DSN
|
|---|
| 696 | c DSN(IBL:73) = ' '
|
|---|
| 697 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 698 |
|
|---|
| 699 | C OPEN ON EXTERNAL STACK
|
|---|
| 700 | C BLOCKS OF 32640 BYTES = 4080 REAL*8 = 340 PARTICLES
|
|---|
| 701 | OPEN(UNIT=EXST,STATUS='SCRATCH',
|
|---|
| 702 | * FORM='UNFORMATTED',ACCESS='DIRECT',RECL=MAXSTK)
|
|---|
| 703 |
|
|---|
| 704 |
|
|---|
| 705 | C-----------------------------------------------------------------------
|
|---|
| 706 | C WRITE DATA SET FOR INFORMATION BANK
|
|---|
| 707 | IF (FDBASE ) THEN
|
|---|
| 708 | C OPEN OUTPUT DATA SET FOR RUN
|
|---|
| 709 | IBL = INDEX(DSN,' ')
|
|---|
| 710 | DSN(IBL:79) = 'DAT000000.dbase'
|
|---|
| 711 | WRITE(DSN(IBL+3:IBL+8),'(I6)') NRRUN
|
|---|
| 712 | DO 275 L = IBL+3,IBL+8
|
|---|
| 713 | IF ( DSN(L:L) .EQ. ' ' ) DSN(L:L) = '0'
|
|---|
| 714 | 275 CONTINUE
|
|---|
| 715 | OPEN(UNIT=MDBASE,FILE=DSN,STATUS='NEW')
|
|---|
| 716 | WRITE(MONIOU,581) DSN
|
|---|
| 717 | 581 FORMAT(/' DBASE OUTPUT TO DIRECTORY : ',A79)
|
|---|
| 718 | C RESET DSN
|
|---|
| 719 | DSN(IBL+9:IBL+14) = ' '
|
|---|
| 720 |
|
|---|
| 721 | LSTDSN(1:3) = 'LST'
|
|---|
| 722 | LSTDSN(4:9) = DSN(IBL+3:IBL+8)
|
|---|
| 723 | VERVEN=FLOAT(IVERVN)/1000.
|
|---|
| 724 | IF ( LLONGI ) THEN
|
|---|
| 725 | ILONG = 1
|
|---|
| 726 | ELSE
|
|---|
| 727 | ILONG = 0
|
|---|
| 728 | ENDIF
|
|---|
| 729 | IF ( EVTH(75) .NE. 0. ) THEN
|
|---|
| 730 | ISO = 0
|
|---|
| 731 | ELSE
|
|---|
| 732 | ISO = 1
|
|---|
| 733 | ENDIF
|
|---|
| 734 | C SET DPMFLAG (0=VENUS, 1=HDPM, 2=SIBYLL, 3=QGSJET, 4=DPMJET)
|
|---|
| 735 | IF ( EVTH( 76) .NE. 0. ) THEN
|
|---|
| 736 | IDPM = 0
|
|---|
| 737 | ELSEIF ( EVTH(139) .NE. 0. ) THEN
|
|---|
| 738 | IDPM = 2
|
|---|
| 739 | ELSEIF ( EVTH(141) .NE. 0. ) THEN
|
|---|
| 740 | IDPM = 3
|
|---|
| 741 | ELSEIF ( EVTH(143) .NE. 0. ) THEN
|
|---|
| 742 | IDPM = 4
|
|---|
| 743 | ELSE
|
|---|
| 744 | IDPM = 1
|
|---|
| 745 | ENDIF
|
|---|
| 746 | C INCREMENT DPMFLAG FOR VARIOUS CROSS SECTIONS
|
|---|
| 747 | C BY (0=HDPM-SIG, 10=VENUSSIG, 20=SIBYLLSIG, 30=QGSSIG, 4=DPMJETSIG)
|
|---|
| 748 | IF ( EVTH(145) .NE. 0 ) THEN
|
|---|
| 749 | IDPM = IDPM + 10
|
|---|
| 750 | ELSEIF ( EVTH(140) .NE. 0 ) THEN
|
|---|
| 751 | IDPM = IDPM + 20
|
|---|
| 752 | ELSEIF ( EVTH(142) .NE. 0 ) THEN
|
|---|
| 753 | IDPM = IDPM + 30
|
|---|
| 754 | ELSEIF ( EVTH(144) .NE. 0 ) THEN
|
|---|
| 755 | IDPM = IDPM + 40
|
|---|
| 756 | ENDIF
|
|---|
| 757 | MARK = '1'
|
|---|
| 758 | LTHIN = .FALSE.
|
|---|
| 759 | EFRAC = 0.D0
|
|---|
| 760 |
|
|---|
| 761 | WRITE(MDBASE,666)VERNUM,MARK,MVDATE,VERVEN,
|
|---|
| 762 | $INT(RUNH(3))+19000000,INT(EVTH(80)),INT(EVTH(79)),INT(EVTH(78)),
|
|---|
| 763 | $INT(EVTH(77)),INT(RUNH(2)),INT(PRMPAR(1)),
|
|---|
| 764 | $LLIMIT,ULIMIT,PSLOPE,INT(RUNH(20)),
|
|---|
| 765 | $INT(RUNH(19)),INT(EVTH(76)),INT(EVTH(75)),ISO,IDPM,
|
|---|
| 766 | $NFLAIN,NFLDIF,NFLPI0,NFLPIF,
|
|---|
| 767 | $NFLCHE,NFRAGM,ILONG,THSTEP,
|
|---|
| 768 | $BX,BZ,NOBSLV,
|
|---|
| 769 | $OBSLEV(1),OBSLEV(2),OBSLEV(3),
|
|---|
| 770 | $OBSLEV(4),OBSLEV(5),OBSLEV(6),
|
|---|
| 771 | $OBSLEV(7),OBSLEV(8),OBSLEV(9),
|
|---|
| 772 | $OBSLEV(10),ELCUT(1),ELCUT(2),ELCUT(3),
|
|---|
| 773 | $ELCUT(4),EVTH(81),EVTH(82),EVTH(83),
|
|---|
| 774 | $EVTH(84),FIXHEI,N1STTR,THICK0,
|
|---|
| 775 | $STEPFC,ARRANG,INT(EVTH(94)),NSEQ,
|
|---|
| 776 | $ISEED(1,1),ISEED(2,1),ISEED(3,1),ISEED(1,2),
|
|---|
| 777 | $ISEED(2,2),ISEED(3,2),ISEED(1,3),
|
|---|
| 778 | $ISEED(2,3),ISEED(3,3),0,DSN,
|
|---|
| 779 | $LSTDSN,' JDD300.01',' JDD300.01',
|
|---|
| 780 | $NSHOW,HOST,USER,LTHIN,EFRAC
|
|---|
| 781 |
|
|---|
| 782 | 666 FORMAT('#version#',F6.3,A1,'#versiondate#',I9,'#venusversion#',
|
|---|
| 783 | $F6.3,'#rundate#',I9,/,'#computer#',I2,'#horizont#',I2,'#neutrino#'
|
|---|
| 784 | $,I2,'#cerenkov#',I2,'#runnumber#',I7,/,'#primary#',I5,
|
|---|
| 785 | $'#e_range_l#',E15.7,'#e_range_u#',E15.7,/,'#slope#',E15.7,'#nkg#',
|
|---|
| 786 | $I2,'#egs#',I2,'#venus#',I2,'#gheisha#',I2,'#isobar#',I2,'#hdpm#',
|
|---|
| 787 | $I2,/,'#hadflag1#',I2,'#hadflag2#',I2,'#hadflag3#',I2,'#hadflag4#',
|
|---|
| 788 | $I2,'#hadflag5#',I2,'#hadflag6#',I2,/,'#longi#',I2,'#longistep#',
|
|---|
| 789 | $E15.7,'#magnetx#',E15.7,/,'#magnetz#',E15.7,'#nobslev#',I3,/,
|
|---|
| 790 | $'#obslev1#',E15.7,'#obslev2#',E15.7,'#obslev3#',E15.7,/,
|
|---|
| 791 | $'#obslev4#',E15.7,'#obslev5#',E15.7,'#obslev6#',E15.7,/,
|
|---|
| 792 | $'#obslev7#',E15.7,'#obslev8#',E15.7,'#obslev9#',E15.7,/,
|
|---|
| 793 | $'#obslev10#',E15.7,'#hcut#',E15.7,'#mcut#',E15.7,/,'#ecut#',E15.7,
|
|---|
| 794 | $'#gcut#',E15.7,'#thetal#',E15.7,/,'#thetau#',E15.7,'#phil#',E15.7,
|
|---|
| 795 | $'#phiu#',E15.7,/,'#fixhei#',E15.7,'#n1sttr#',I3,'#fixchi#',E15.7,
|
|---|
| 796 | $/,'#stepfc#',E15.7,'#arrang#',E15.7,'#muaddi#',I2,'#nseq#',I2,/,
|
|---|
| 797 | $'#seq1seed1#',I9,'#seq1seed2#',I9,'#seq1seed3#',I9,/,'#seq2seed1#'
|
|---|
| 798 | $,I9,'#seq2seed2#',I9,'#seq2seed3#',I9,/,'#seq3seed1#',I9,
|
|---|
| 799 | $'#seq3seed2#',I9,'#seq3seed3#',I9,/,'#size#',I10,'#dsn_events#',
|
|---|
| 800 | $A59,/,'#dsn_prtout# ',A9,'#tape_name#',A10,'#backup#',A10,/,
|
|---|
| 801 | $'#howmanyshowers#',I10,'#host#',A20,'#user#',A20,/
|
|---|
| 802 | $'#thinning#',L4,'#thinninglevel#',E15.7)
|
|---|
| 803 |
|
|---|
| 804 | C RESET DSN
|
|---|
| 805 | DSN(IBL:IBL+14) = ' '
|
|---|
| 806 | CLOSE(UNIT=MDBASE)
|
|---|
| 807 | ENDIF
|
|---|
| 808 |
|
|---|
| 809 | WRITE(MONIOU,*)'NUMBER OF SHOWERS TO GENERATE =',NSHOW
|
|---|
| 810 | WRITE(MONIOU,*)
|
|---|
| 811 | RETURN
|
|---|
| 812 | END
|
|---|