| 1 |
|
|---|
| 2 | PROGRAM MAIN
|
|---|
| 3 |
|
|---|
| 4 | C-----------------------------------------------------------------------
|
|---|
| 5 | C MAIN PROGRAM
|
|---|
| 6 | C
|
|---|
| 7 | C SIMULATION OF EXTENSIVE AIR SHOWERS
|
|---|
| 8 | C PREPARES INITIALIZATIONS
|
|---|
| 9 | C GENERATES SHOWERS IN THE SHOWER LOOP
|
|---|
| 10 | C TREATES PARTICLES IN THE PARTICLE LOOP
|
|---|
| 11 | C PERFORMS PRINTING OF TABLES AT END OF SHOWER AND AT END OF RUN
|
|---|
| 12 | C-----------------------------------------------------------------------
|
|---|
| 13 |
|
|---|
| 14 | IMPLICIT DOUBLE PRECISION (A-H,O-Z)
|
|---|
| 15 |
|
|---|
| 16 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 17 | parameter (xct=1)
|
|---|
| 18 | parameter (yct=2)
|
|---|
| 19 | parameter (zct=3)
|
|---|
| 20 | parameter (ctthet=4)
|
|---|
| 21 | parameter (ctphi=5)
|
|---|
| 22 | parameter (ctdiam=6)
|
|---|
| 23 | parameter (ctfoc=7)
|
|---|
| 24 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 25 |
|
|---|
| 26 | *KEEP,BAL.
|
|---|
| 27 | COMMON /BAL/ EBAL
|
|---|
| 28 | DOUBLE PRECISION EBAL(10)
|
|---|
| 29 | *KEEP,BUFFS.
|
|---|
| 30 | COMMON /BUFFS/ RUNH,RUNE,EVTH,EVTE,DATAB,LH
|
|---|
| 31 | INTEGER MAXBUF,MAXLEN
|
|---|
| 32 | PARAMETER (MAXBUF=39*7)
|
|---|
| 33 | PARAMETER (MAXLEN=12)
|
|---|
| 34 | REAL RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
|
|---|
| 35 | * RUNE(MAXBUF),DATAB(MAXBUF)
|
|---|
| 36 | INTEGER LH
|
|---|
| 37 | CHARACTER*4 CRUNH,CRUNE,CEVTH,CEVTE
|
|---|
| 38 | EQUIVALENCE (RUNH(1),CRUNH), (RUNE(1),CRUNE)
|
|---|
| 39 | EQUIVALENCE (EVTH(1),CEVTH), (EVTE(1),CEVTE)
|
|---|
| 40 | *KEEP,CHISTA.
|
|---|
| 41 | COMMON /CHISTA/ IHYCHI,IKACHI,IMUCHI,INNCHI,INUCHI,IPICHI
|
|---|
| 42 | INTEGER IHYCHI(124),IKACHI(124),IMUCHI(124),
|
|---|
| 43 | * INNCHI(124),INUCHI(124),IPICHI(124)
|
|---|
| 44 | *KEEP,CONST.
|
|---|
| 45 | COMMON /CONST/ PI,PI2,OB3,TB3,ENEPER
|
|---|
| 46 | DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
|
|---|
| 47 | *KEEP,CURVE.
|
|---|
| 48 | COMMON /CURVE/ CHAPAR,DEP,ERR,NSTP
|
|---|
| 49 | DOUBLE PRECISION CHAPAR(1100),DEP(1100),ERR(1100)
|
|---|
| 50 | INTEGER NSTP
|
|---|
| 51 | *KEEP,ELADPM.
|
|---|
| 52 | COMMON /ELADPM/ ELMEAN,ELMEAA,IELDPM,IELDPA
|
|---|
| 53 | DOUBLE PRECISION ELMEAN(37),ELMEAA(37)
|
|---|
| 54 | INTEGER IELDPM(37,13),IELDPA(37,13)
|
|---|
| 55 | *KEEP,ELASTY.
|
|---|
| 56 | COMMON /ELASTY/ ELAST,IELIS,IELHM,IELNU,IELPI
|
|---|
| 57 | DOUBLE PRECISION ELAST
|
|---|
| 58 | INTEGER IELIS(20),IELHM(20),IELNU(20),IELPI(20)
|
|---|
| 59 | *KEEP,GENER.
|
|---|
| 60 | COMMON /GENER/ GEN,ALEVEL
|
|---|
| 61 | DOUBLE PRECISION GEN,ALEVEL
|
|---|
| 62 | *KEEP,IRET.
|
|---|
| 63 | COMMON /IRET/ IRET1,IRET2
|
|---|
| 64 | INTEGER IRET1,IRET2
|
|---|
| 65 | *KEEP,ISTA.
|
|---|
| 66 | COMMON /ISTA/ IFINET,IFINNU,IFINKA,IFINPI,IFINHY
|
|---|
| 67 | INTEGER IFINET,IFINNU,IFINKA,IFINPI,IFINHY
|
|---|
| 68 | *KEEP,LONGI.
|
|---|
| 69 | COMMON /LONGI/ APLONG,HLONG,PLONG,SPLONG,THSTEP,THSTPI,
|
|---|
| 70 | * NSTEP,LLONGI,FLGFIT
|
|---|
| 71 | DOUBLE PRECISION APLONG(0:1040,9),HLONG(0:1024),PLONG(0:1040,9),
|
|---|
| 72 | * SPLONG(0:1040,9),THSTEP,THSTPI
|
|---|
| 73 | INTEGER NSTEP
|
|---|
| 74 | LOGICAL LLONGI,FLGFIT
|
|---|
| 75 | *KEEP,MPARTI.
|
|---|
| 76 | COMMON /MPARTI/ MPARTO
|
|---|
| 77 | DOUBLE PRECISION MPARTO(10,25),MPHOTO(10),MPOSIT(10),MELECT(10),
|
|---|
| 78 | * MNU(10),MMUP(10),MMUM(10),MPI0(10),MPIP(10),
|
|---|
| 79 | * MPIM(10),MK0L(10),MKPL(10),MKMI(10),MNEUTR(10),
|
|---|
| 80 | * MPROTO(10),MPROTB(10),MK0S(10),MHYP(10),
|
|---|
| 81 | * MNEUTB(10),MDEUT(10),MTRIT(10),MALPHA(10),
|
|---|
| 82 | * MOTHER(10)
|
|---|
| 83 | EQUIVALENCE (MPARTO(1, 1),MPHOTO(1)), (MPARTO(1, 2),MPOSIT(1)),
|
|---|
| 84 | * (MPARTO(1, 3),MELECT(1)), (MPARTO(1, 4),MNU(1)) ,
|
|---|
| 85 | * (MPARTO(1, 5),MMUP(1)) , (MPARTO(1, 6),MMUM(1)) ,
|
|---|
| 86 | * (MPARTO(1, 7),MPI0(1)) , (MPARTO(1, 8),MPIP(1)) ,
|
|---|
| 87 | * (MPARTO(1, 9),MPIM(1)) , (MPARTO(1,10),MK0L(1)) ,
|
|---|
| 88 | * (MPARTO(1,11),MKPL(1)) , (MPARTO(1,12),MKMI(1)) ,
|
|---|
| 89 | * (MPARTO(1,13),MNEUTR(1)), (MPARTO(1,14),MPROTO(1)),
|
|---|
| 90 | * (MPARTO(1,15),MPROTB(1)), (MPARTO(1,16),MK0S(1)) ,
|
|---|
| 91 | * (MPARTO(1,18),MHYP(1)) , (MPARTO(1,19),MDEUT(1)) ,
|
|---|
| 92 | * (MPARTO(1,20),MTRIT(1)) , (MPARTO(1,21),MALPHA(1)),
|
|---|
| 93 | * (MPARTO(1,22),MOTHER(1)), (MPARTO(1,25),MNEUTB(1))
|
|---|
| 94 | *KEEP,MULT.
|
|---|
| 95 | COMMON /MULT/ EKINL,MSMM,MULTMA,MULTOT
|
|---|
| 96 | DOUBLE PRECISION EKINL
|
|---|
| 97 | INTEGER MSMM,MULTMA(37,13),MULTOT(37,13)
|
|---|
| 98 | *KEEP,MUPART.
|
|---|
| 99 | COMMON /MUPART/ AMUPAR,BCUT,CMUON,FMUBRM,FMUORG
|
|---|
| 100 | DOUBLE PRECISION AMUPAR(14),BCUT,CMUON(11)
|
|---|
| 101 | LOGICAL FMUBRM,FMUORG
|
|---|
| 102 | *KEEP,NCOUNT.
|
|---|
| 103 | COMMON /NCOUNT/ NCOUN
|
|---|
| 104 | INTEGER NCOUN(8)
|
|---|
| 105 | *KEEP,NKGI.
|
|---|
| 106 | COMMON /NKGI/ SEL,SELLG,STH,ZEL,ZELLG,ZSL,DIST,
|
|---|
| 107 | * DISX,DISY,DISXY,DISYX,DLAX,DLAY,DLAXY,DLAYX,
|
|---|
| 108 | * OBSATI,RADNKG,RMOL,TLEV,TLEVCM,IALT
|
|---|
| 109 | DOUBLE PRECISION SEL(10),SELLG(10),STH(10),ZEL(10),ZELLG(10),
|
|---|
| 110 | * ZSL(10),DIST(10),
|
|---|
| 111 | * DISX(-10:10),DISY(-10:10),
|
|---|
| 112 | * DISXY(-10:10,2),DISYX(-10:10,2),
|
|---|
| 113 | * DLAX (-10:10,2),DLAY (-10:10,2),
|
|---|
| 114 | * DLAXY(-10:10,2),DLAYX(-10:10,2),
|
|---|
| 115 | * OBSATI(2),RADNKG,RMOL(2),TLEV(10),TLEVCM(10)
|
|---|
| 116 | INTEGER IALT(2)
|
|---|
| 117 | *KEEP,NKGS.
|
|---|
| 118 | COMMON /NKGS/ CZX,CZY,CZXY,CZYX,SAH,SL,ZNE
|
|---|
| 119 | DOUBLE PRECISION CZX(-10:10,2),CZY(-10:10,2),CZXY(-10:10,2),
|
|---|
| 120 | * CZYX(-10:10,2),SAH(10),SL(10),ZNE(10)
|
|---|
| 121 | *KEEP,NPARTI.
|
|---|
| 122 | COMMON /NPARTI/ NPARTO,MUOND
|
|---|
| 123 | DOUBLE PRECISION NPARTO(10,25),NPHOTO(10),NPOSIT(10),NELECT(10),
|
|---|
| 124 | * NNU(10),NMUP(10),NMUM(10),NPI0(10),NPIP(10),
|
|---|
| 125 | * NPIM(10),NK0L(10),NKPL(10),NKMI(10),NNEUTR(10),
|
|---|
| 126 | * NPROTO(10),NPROTB(10),NK0S(10),NHYP(10),
|
|---|
| 127 | * NNEUTB(10),NDEUT(10),NTRIT(10),NALPHA(10),
|
|---|
| 128 | * NOTHER(10),MUOND
|
|---|
| 129 | EQUIVALENCE (NPARTO(1, 1),NPHOTO(1)), (NPARTO(1, 2),NPOSIT(1)),
|
|---|
| 130 | * (NPARTO(1, 3),NELECT(1)), (NPARTO(1, 4),NNU(1)) ,
|
|---|
| 131 | * (NPARTO(1, 5),NMUP(1)) , (NPARTO(1, 6),NMUM(1)) ,
|
|---|
| 132 | * (NPARTO(1, 7),NPI0(1)) , (NPARTO(1, 8),NPIP(1)) ,
|
|---|
| 133 | * (NPARTO(1, 9),NPIM(1)) , (NPARTO(1,10),NK0L(1)) ,
|
|---|
| 134 | * (NPARTO(1,11),NKPL(1)) , (NPARTO(1,12),NKMI(1)) ,
|
|---|
| 135 | * (NPARTO(1,13),NNEUTR(1)), (NPARTO(1,14),NPROTO(1)),
|
|---|
| 136 | * (NPARTO(1,15),NPROTB(1)), (NPARTO(1,16),NK0S(1)) ,
|
|---|
| 137 | * (NPARTO(1,18),NHYP(1)) , (NPARTO(1,19),NDEUT(1)) ,
|
|---|
| 138 | * (NPARTO(1,20),NTRIT(1)) , (NPARTO(1,21),NALPHA(1)),
|
|---|
| 139 | * (NPARTO(1,22),NOTHER(1)), (NPARTO(1,25),NNEUTB(1))
|
|---|
| 140 | *KEEP,OBSPAR.
|
|---|
| 141 | COMMON /OBSPAR/ OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
|
|---|
| 142 | * THETPR,PHIPR,NOBSLV
|
|---|
| 143 | DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
|
|---|
| 144 | * THETAP,THETPR(2),PHIP,PHIPR(2)
|
|---|
| 145 | INTEGER NOBSLV
|
|---|
| 146 | *KEEP,PAM.
|
|---|
| 147 | COMMON /PAM/ PAMA,SIGNUM
|
|---|
| 148 | DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
|
|---|
| 149 | *KEEP,PARPAR.
|
|---|
| 150 | COMMON /PARPAR/ CURPAR,SECPAR,PRMPAR,OUTPAR,C,
|
|---|
| 151 | * E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
|
|---|
| 152 | DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
|
|---|
| 153 | * C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
|
|---|
| 154 | INTEGER ITYPE,LEVL
|
|---|
| 155 | *KEEP,PARPAE.
|
|---|
| 156 | DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
|
|---|
| 157 | EQUIVALENCE (CURPAR(2),GAMMA), (CURPAR(3),COSTHE),
|
|---|
| 158 | * (CURPAR(4), PHI ), (CURPAR(5), H ),
|
|---|
| 159 | * (CURPAR(6), T ), (CURPAR(7), X ),
|
|---|
| 160 | * (CURPAR(8), Y ), (CURPAR(9), CHI ),
|
|---|
| 161 | * (CURPAR(10),BETA), (CURPAR(11),GCM ),
|
|---|
| 162 | * (CURPAR(12),ECM )
|
|---|
| 163 | *KEEP,PBALA.
|
|---|
| 164 | COMMON /PBALA/ PBAL
|
|---|
| 165 | DOUBLE PRECISION PBAL(10)
|
|---|
| 166 | *KEEP,PRIMSP.
|
|---|
| 167 | COMMON /PRIMSP/ PSLOPE,LLIMIT,ULIMIT,LL,UL,SLEX,ISPEC
|
|---|
| 168 | DOUBLE PRECISION PSLOPE,LLIMIT,ULIMIT,LL,UL,SLEX
|
|---|
| 169 | INTEGER ISPEC
|
|---|
| 170 | *KEEP,RANDPA.
|
|---|
| 171 | COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR
|
|---|
| 172 | DOUBLE PRECISION FAC,U1,U2
|
|---|
| 173 | REAL RD(3000)
|
|---|
| 174 | INTEGER ISEED(103,10),NSEQ
|
|---|
| 175 | LOGICAL KNOR
|
|---|
| 176 | *KEEP,RECORD.
|
|---|
| 177 | COMMON /RECORD/ IRECOR
|
|---|
| 178 | INTEGER IRECOR
|
|---|
| 179 | *KEEP,REJECT.
|
|---|
| 180 | COMMON /REJECT/ AVNREJ,
|
|---|
| 181 | * ALTMIN,ANEXP,THICKA,THICKD,CUTLN,EONCUT,
|
|---|
| 182 | * FNPRIM
|
|---|
| 183 | DOUBLE PRECISION AVNREJ(10)
|
|---|
| 184 | REAL ALTMIN(10),ANEXP(10),THICKA(10),THICKD(10),
|
|---|
| 185 | * CUTLN,EONCUT
|
|---|
| 186 | LOGICAL FNPRIM
|
|---|
| 187 | *KEEP,RESON.
|
|---|
| 188 | COMMON /RESON/ RDRES,RESRAN,IRESPAR
|
|---|
| 189 | REAL RDRES(2),RESRAN(1000)
|
|---|
| 190 | INTEGER IRESPAR
|
|---|
| 191 |
|
|---|
| 192 | *KEEP,RUNPAR.
|
|---|
| 193 | COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
|
|---|
| 194 | * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
|
|---|
| 195 | * MONIOU,MDEBUG,NUCNUC,
|
|---|
| 196 | * CETAPE,
|
|---|
| 197 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
|---|
| 198 | * N1STTR,MDBASE,
|
|---|
| 199 | * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
|---|
| 200 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
|---|
| 201 | * ,GHEISH,GHESIG
|
|---|
| 202 | COMMON /RUNPAC/ DSN,HOST,USER
|
|---|
| 203 | DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
|
|---|
| 204 | REAL STEPFC
|
|---|
| 205 | INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
|
|---|
| 206 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
|---|
| 207 | * N1STTR,MDBASE
|
|---|
| 208 | INTEGER CETAPE
|
|---|
| 209 | CHARACTER*79 DSN
|
|---|
| 210 | CHARACTER*20 HOST,USER
|
|---|
| 211 |
|
|---|
| 212 | LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
|---|
| 213 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
|---|
| 214 | * ,GHEISH,GHESIG
|
|---|
| 215 | *KEEP,STACKF.
|
|---|
| 216 | COMMON /STACKF/ STACK,STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
|
|---|
| 217 | INTEGER MAXSTK
|
|---|
| 218 | PARAMETER (MAXSTK = 12*340*2)
|
|---|
| 219 | DOUBLE PRECISION STACK(MAXSTK)
|
|---|
| 220 | INTEGER STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
|
|---|
| 221 | *KEEP,STATI.
|
|---|
| 222 | COMMON /STATI/ SABIN,SBBIN,INBIN,IPBIN,IKBIN,IHBIN
|
|---|
| 223 | DOUBLE PRECISION SABIN(37),SBBIN(37)
|
|---|
| 224 | INTEGER INBIN(37),IPBIN(37),IKBIN(37),IHBIN(37)
|
|---|
| 225 | *KEEP,THNVAR.
|
|---|
| 226 | COMMON /THNVAR/ STACKINT,INT_ICOUNT,THINNING
|
|---|
| 227 | INTEGER MAXICOUNT
|
|---|
| 228 | PARAMETER (MAXICOUNT=20000)
|
|---|
| 229 | DOUBLE PRECISION STACKINT(MAXICOUNT,13)
|
|---|
| 230 | INTEGER INT_ICOUNT
|
|---|
| 231 | LOGICAL THINNING
|
|---|
| 232 | *KEEP,VERS.
|
|---|
| 233 | COMMON /VERS/ VERNUM,MVDATE,VERDAT
|
|---|
| 234 | DOUBLE PRECISION VERNUM
|
|---|
| 235 | INTEGER MVDATE
|
|---|
| 236 | CHARACTER*18 VERDAT
|
|---|
| 237 | *KEEP,CEREN1.
|
|---|
| 238 | COMMON /CEREN1/ CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD,
|
|---|
| 239 | * CERSIZ,LCERFI
|
|---|
| 240 | DOUBLE PRECISION CERELE,CERHAD,ETADSN,WAVLGL,WAVLGU,CYIELD
|
|---|
| 241 | REAL CERSIZ
|
|---|
| 242 | LOGICAL LCERFI
|
|---|
| 243 | *KEEP,CEREN2.
|
|---|
| 244 | COMMON /CEREN2/ PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
|
|---|
| 245 | * DCERX,DCERY,ACERX,ACERY,
|
|---|
| 246 | * XCMAX,YCMAX,EPSX,EPSY,
|
|---|
| 247 | * DCERXI,DCERYI,FCERX,FCERY,
|
|---|
| 248 | * XSCATT,YSCATT,CERXOS,CERYOS,
|
|---|
| 249 | * NCERX,NCERY,ICERML
|
|---|
| 250 | REAL PHOTCM,XCER,YCER,UEMIS,VEMIS,CARTIM,ZEMIS,
|
|---|
| 251 | * DCERX,DCERY,ACERX,ACERY,
|
|---|
| 252 | * XCMAX,YCMAX,EPSX,EPSY,
|
|---|
| 253 | * DCERXI,DCERYI,FCERX,FCERY,
|
|---|
| 254 | * XSCATT,YSCATT,CERXOS(20),CERYOS(20)
|
|---|
| 255 | INTEGER NCERX,NCERY,ICERML
|
|---|
| 256 | *KEEP,CEREN3.
|
|---|
| 257 | COMMON /CEREN3/ CERCNT,DATAB2,LHCER
|
|---|
| 258 | INTEGER MAXBF2
|
|---|
| 259 | PARAMETER (MAXBF2 = 39 * 7)
|
|---|
| 260 | DOUBLE PRECISION CERCNT
|
|---|
| 261 | REAL DATAB2(MAXBF2)
|
|---|
| 262 | INTEGER LHCER
|
|---|
| 263 | *KEEP,CEREN4.
|
|---|
| 264 | COMMON /CEREN4/ NRECER
|
|---|
| 265 | INTEGER NRECER
|
|---|
| 266 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 267 | *keep,certel.
|
|---|
| 268 | common /certel/ cormxd,cord,coralp,ctpars,omega,
|
|---|
| 269 | + photn,photnp,phpt,pht,vphot,
|
|---|
| 270 | + vchi,veta,vzeta,vchim,vetam,vzetam,
|
|---|
| 271 | + lambda,mu,nu,nctels,ncph
|
|---|
| 272 | double precision cormxd,cord,coralp,ctpars(20,7),omega(20,3,3),
|
|---|
| 273 | + photn(3),photnp(3),phpt(3),pht,vphot(3),
|
|---|
| 274 | + vchi(3),veta(3),vzeta(3),vchim,vetam,vzetam,
|
|---|
| 275 | + lambda,mu,nu
|
|---|
| 276 | integer nctels,ncph(5)
|
|---|
| 277 | double precision xg,yg,zg,xgp,ygp,zgp,up,vp,wp,xpcut,ypcut,zpcut
|
|---|
| 278 | equivalence (photn(1) ,xg) ,(photn(2) ,yg) ,(photn(3) ,zg) ,
|
|---|
| 279 | + (photnp(1),xgp) ,(photnp(2),ygp) ,(photnp(3),zgp),
|
|---|
| 280 | + (phpt(1) ,xpcut),(phpt(2) ,ypcut),(phpt(3) ,zpcut),
|
|---|
| 281 | + (vphot(1) ,up) ,(vphot(2) ,vp) ,(vphot(3) ,wp)
|
|---|
| 282 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 283 | C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 284 | C Modificacion hecha por Aitor (5-feb-98)
|
|---|
| 285 | common /aitor/ aitoth
|
|---|
| 286 | double precision aitoth
|
|---|
| 287 | C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 288 | C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 289 | c Angles for the "spinning" of a particle around the
|
|---|
| 290 | c main axis of the CT
|
|---|
| 291 | common /spinang/ spinxi
|
|---|
| 292 | double precision spinxi
|
|---|
| 293 | C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 294 |
|
|---|
| 295 |
|
|---|
| 296 | *KEND.
|
|---|
| 297 |
|
|---|
| 298 | INTEGER JNBIN(37),JPBIN(37),JKBIN(37),JHBIN(37)
|
|---|
| 299 | DOUBLE PRECISION CHI2,FPARAM(6)
|
|---|
| 300 | DOUBLE PRECISION MPART2(10,25),MPHOT2(10),MPOSI2(10),MELEC2(10),
|
|---|
| 301 | * MNU2(10),MMUP2(10),MMUM2(10),MPI02(10),MPIP2(10),
|
|---|
| 302 | * MPIM2(10),MK0L2(10),MKPL2(10),MKMI2(10),
|
|---|
| 303 | * MNETR2(10),MPROT2(10),MPRTB2(10),MK0S2(10),
|
|---|
| 304 | * MHYP2(10),MNETB2(10),MDEUT2(10),MTRIT2(10),
|
|---|
| 305 | * MALPH2(10),MOTH2(10)
|
|---|
| 306 | EQUIVALENCE (MPART2(1, 1),MPHOT2(1)), (MPART2(1, 2),MPOSI2(1)),
|
|---|
| 307 | * (MPART2(1, 3),MELEC2(1)), (MPART2(1, 4),MNU2(1)) ,
|
|---|
| 308 | * (MPART2(1, 5),MMUP2(1)) , (MPART2(1, 6),MMUM2(1)) ,
|
|---|
| 309 | * (MPART2(1, 7),MPI02(1)) , (MPART2(1, 8),MPIP2(1)) ,
|
|---|
| 310 | * (MPART2(1, 9),MPIM2(1)) , (MPART2(1,10),MK0L2(1)) ,
|
|---|
| 311 | * (MPART2(1,11),MKPL2(1)) , (MPART2(1,12),MKMI2(1)) ,
|
|---|
| 312 | * (MPART2(1,13),MNETR2(1)), (MPART2(1,14),MPROT2(1)),
|
|---|
| 313 | * (MPART2(1,15),MPRTB2(1)), (MPART2(1,16),MK0S2(1)) ,
|
|---|
| 314 | * (MPART2(1,18),MHYP2(1)) , (MPART2(1,19),MDEUT2(1)),
|
|---|
| 315 | * (MPART2(1,20),MTRIT2(1)), (MPART2(1,21),MALPH2(1)),
|
|---|
| 316 | * (MPART2(1,22),MOTH2 (1)), (MPART2(1,25),MNETB2(1))
|
|---|
| 317 | C VARIABLES BEING USED FOR RUNTIME
|
|---|
| 318 | REAL TDIFF
|
|---|
| 319 | INTEGER ILEFTA,ILEFTB,TIME
|
|---|
| 320 | EXTERNAL TIME
|
|---|
| 321 |
|
|---|
| 322 | C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 323 | double precision ctdiams(20)
|
|---|
| 324 | C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 325 | double precision theprim, phiprim
|
|---|
| 326 | double precision spinthe, spinphi
|
|---|
| 327 | C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 328 |
|
|---|
| 329 |
|
|---|
| 330 | C-----------------------------------------------------------------------
|
|---|
| 331 |
|
|---|
| 332 |
|
|---|
| 333 | CERELE = 0.D0
|
|---|
| 334 | CERHAD = 0.D0
|
|---|
| 335 | NRECER = 0
|
|---|
| 336 | C INITIALIZE AND READ RUN STEERING CARDS
|
|---|
| 337 | CALL START
|
|---|
| 338 |
|
|---|
| 339 | IF ( CERSIZ .LE. 0. ) THEN
|
|---|
| 340 | ICRSIZ = 0
|
|---|
| 341 | ELSE
|
|---|
| 342 | ICRSIZ = 1
|
|---|
| 343 | ENDIF
|
|---|
| 344 |
|
|---|
| 345 | C RESET COUNTER FOR WORDS WRITTEN TO TAPE
|
|---|
| 346 | IRECOR = 0
|
|---|
| 347 |
|
|---|
| 348 | C RESET COUNTER FOR AVERAGE HIGHT OF 1ST INTERACTION
|
|---|
| 349 | CHISUM = 0.D0
|
|---|
| 350 | CHISM2 = 0.D0
|
|---|
| 351 |
|
|---|
| 352 | C SET ARRAYS FOR SCALES OF KINETIC ENERGY-INTERACTION TABLE
|
|---|
| 353 | SABIN(1) = 0.D0
|
|---|
| 354 | SBBIN(1) = 0.1D0
|
|---|
| 355 | DO 13 J = 2,37
|
|---|
| 356 | SABIN(J) = 10.D0**((J-4.D0)/3.D0)
|
|---|
| 357 | SBBIN(J) = 10.D0**((J-3.D0)/3.D0)
|
|---|
| 358 | 13 CONTINUE
|
|---|
| 359 |
|
|---|
| 360 | C CHECK AND SET PRIMARY PARAMETERS
|
|---|
| 361 | CALL INPRM
|
|---|
| 362 |
|
|---|
| 363 | do 161 i=1,nctels
|
|---|
| 364 | ctdiams(i) = ctpars(i,ctdiam)
|
|---|
| 365 | 161 continue
|
|---|
| 366 |
|
|---|
| 367 | C INITIALIZE NKG ROUTINES
|
|---|
| 368 | CALL ININKG
|
|---|
| 369 |
|
|---|
| 370 | C RESET COUNTERS FOR NUCLEON, PION AND KAON TABLE FOR ALL SHOWERS
|
|---|
| 371 | C RESET ENERGY-MULTIPLICITY & ENERGY-ELASTICITY MATRIX FOR ALL SHOWERS
|
|---|
| 372 | DO 17 J = 1,37
|
|---|
| 373 | JNBIN(J) = 0
|
|---|
| 374 | JPBIN(J) = 0
|
|---|
| 375 | JKBIN(J) = 0
|
|---|
| 376 | JHBIN(J) = 0
|
|---|
| 377 | ELMEAA(J) = 0.D0
|
|---|
| 378 | DO 17 L = 1,13
|
|---|
| 379 | MULTOT(J,L) = 0
|
|---|
| 380 | IELDPA(J,L) = 0
|
|---|
| 381 | 17 CONTINUE
|
|---|
| 382 |
|
|---|
| 383 | C RESET OTHER ARRAYS FOR ALL SHOWERS
|
|---|
| 384 | DO 99 J = 1,20
|
|---|
| 385 | IELNU(J) = 0
|
|---|
| 386 | IELPI(J) = 0
|
|---|
| 387 | IELIS(J) = 0
|
|---|
| 388 | IELHM(J) = 0
|
|---|
| 389 | 99 CONTINUE
|
|---|
| 390 |
|
|---|
| 391 | C RESET ARRAYS FOR INTERACTION LENGTH STATISTICS
|
|---|
| 392 | DO 90 J = 1,124
|
|---|
| 393 | IHYCHI(J) = 0
|
|---|
| 394 | IKACHI(J) = 0
|
|---|
| 395 | IMUCHI(J) = 0
|
|---|
| 396 | INUCHI(J) = 0
|
|---|
| 397 | IPICHI(J) = 0
|
|---|
| 398 | INNCHI(J) = 0
|
|---|
| 399 | 90 CONTINUE
|
|---|
| 400 |
|
|---|
| 401 | C RESET ARRAY FOR MEAN VALUES AND STANDARD DEVIATION
|
|---|
| 402 | DO 477 K = 1,25
|
|---|
| 403 | DO 477 J = 1,10
|
|---|
| 404 | MPARTO(J,K) = 0.D0
|
|---|
| 405 | MPART2(J,K) = 0.D0
|
|---|
| 406 | 477 CONTINUE
|
|---|
| 407 |
|
|---|
| 408 | C RESET ARRAYS FOR LONGITUDINAL DISTRIBUTION
|
|---|
| 409 | IF ( LLONGI ) THEN
|
|---|
| 410 | DO 478 K = 1,9
|
|---|
| 411 | DO 4781 J = 0,NSTEP
|
|---|
| 412 | APLONG(J,K) = 0.D0
|
|---|
| 413 | SPLONG(J,K) = 0.D0
|
|---|
| 414 | 4781 CONTINUE
|
|---|
| 415 | 478 CONTINUE
|
|---|
| 416 | ENDIF
|
|---|
| 417 |
|
|---|
| 418 | C STEERING OF PRINTOUT OF RANDOM GENERATOR SEEDS
|
|---|
| 419 | IPROUT = MIN(100,NSHOW/20)
|
|---|
| 420 | IPROUT = MAX(1,IPROUT)
|
|---|
| 421 |
|
|---|
| 422 | C TIME AT BEGINNING
|
|---|
| 423 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 424 | c ILEFTA = TIME()
|
|---|
| 425 | ILEFTA = 0
|
|---|
| 426 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 427 |
|
|---|
| 428 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 429 | print *,'JCIO::========================================'
|
|---|
| 430 | print *,'JCIO:: Initializing JCIO system for advanced'
|
|---|
| 431 | print *,'JCIO:: saving of data.'
|
|---|
| 432 | print *,'JCIO::========================================'
|
|---|
| 433 | c- initialize jcio system
|
|---|
| 434 | call jcinitio(dsn,nrrun)
|
|---|
| 435 | c- create file run######
|
|---|
| 436 | call jcstartrun(runh)
|
|---|
| 437 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 438 |
|
|---|
| 439 | C-----------------------------------------------------------------------
|
|---|
| 440 | C LOOP OVER SHOWERS
|
|---|
| 441 | DO 2 ISHW = 1,NSHOW
|
|---|
| 442 |
|
|---|
| 443 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 444 | c Next block of code has been modified, and comes from INPRM
|
|---|
| 445 | c----------------------------------------------------------------------
|
|---|
| 446 | C SCATTERING OF CENTER OF CHERENKOV ARRAY RELATIVE TO SHOWER AXIS
|
|---|
| 447 | c>> Actually, XSCATT and YSCATT should be RminSCATT and RmaxSCATT
|
|---|
| 448 | ICERML = MIN(MAX(ICERML,1),20)
|
|---|
| 449 | XSCATT = ABS(XSCATT)
|
|---|
| 450 | YSCATT = ABS(YSCATT)
|
|---|
| 451 | WRITE(MONIOU,5225)ICERML,XSCATT,YSCATT
|
|---|
| 452 | 5225 FORMAT(' ** USING EACH SHOWER SEVERAL TIMES:'/
|
|---|
| 453 | + ' USE EACH EVENT ',I2,' TIMES'/
|
|---|
| 454 | + ' THE EVENTS ARE SCATTERED RANDOMLY IN A SECTOR OF RADII:'/
|
|---|
| 455 | + ' Rmin = ',F10.0,' Rmax = ',F10.0)
|
|---|
| 456 | DO 4438 I=1,ICERML
|
|---|
| 457 | 5226 CALL RMMAR( RD,2,3 )
|
|---|
| 458 | CERXOS(I) = 2.0*YSCATT*(RD(1)-0.5)
|
|---|
| 459 | CERYOS(I) = 2.0*YSCATT*(RD(2)-0.5)
|
|---|
| 460 | R=SQRT(CERXOS(I)**2+CERYOS(I)**2)
|
|---|
| 461 | IF ((R.LT.XSCATT).OR.(R.GT.YSCATT)) GOTO 5226
|
|---|
| 462 | WRITE(MONIOU,4437) I,CERXOS(I),CERYOS(I)
|
|---|
| 463 | 4437 FORMAT(' CORE OF EVENT ',I2,' AT ',2F12.2)
|
|---|
| 464 | 4438 CONTINUE
|
|---|
| 465 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 466 |
|
|---|
| 467 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 468 | c Next block of code comes from INPRM
|
|---|
| 469 | c----------------------------------------------------------------------
|
|---|
| 470 | EVTH(98) = FLOAT(ICERML)
|
|---|
| 471 | DO 480 I=1,20
|
|---|
| 472 | EVTH( 98+I) = CERXOS(I)
|
|---|
| 473 | EVTH(118+I) = CERYOS(I)
|
|---|
| 474 | 480 CONTINUE
|
|---|
| 475 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 476 |
|
|---|
| 477 | SHOWNO = SHOWNO + 1
|
|---|
| 478 | I = ISHW
|
|---|
| 479 | IF ( ISHW .LE. MAXPRT ) THEN
|
|---|
| 480 | FPRINT = .TRUE.
|
|---|
| 481 | ELSE
|
|---|
| 482 | FPRINT = .FALSE.
|
|---|
| 483 | ENDIF
|
|---|
| 484 |
|
|---|
| 485 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 486 | c Create cer######,dat######,sta###### files
|
|---|
| 487 | c------------------------------------------------------------
|
|---|
| 488 | call jcnewshower
|
|---|
| 489 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 490 |
|
|---|
| 491 | C RESET COUNTERS
|
|---|
| 492 | DO 447 K = 1,25
|
|---|
| 493 | DO 447 J = 1,10
|
|---|
| 494 | NPARTO(J,K) = 0.D0
|
|---|
| 495 | 447 CONTINUE
|
|---|
| 496 | MUOND = 0.D0
|
|---|
| 497 |
|
|---|
| 498 | C RESET ARRAY FOR LONGITUDINAL DISTRIBUTION PER SHOWER
|
|---|
| 499 | IF ( LLONGI ) THEN
|
|---|
| 500 | DO 479 K = 1,9
|
|---|
| 501 | DO 4791 J = 0,NSTEP
|
|---|
| 502 | PLONG(J,K) = 0.D0
|
|---|
| 503 | 4791 CONTINUE
|
|---|
| 504 | 479 CONTINUE
|
|---|
| 505 | ENDIF
|
|---|
| 506 |
|
|---|
| 507 | NRECS = 0
|
|---|
| 508 | NBLKS = 0
|
|---|
| 509 | DO 922 KKK = 1,10
|
|---|
| 510 | AVNREJ(KKK) = 0.D0
|
|---|
| 511 | 922 CONTINUE
|
|---|
| 512 | IRESPAR = 0
|
|---|
| 513 |
|
|---|
| 514 |
|
|---|
| 515 | C FIRST INTERACTION DATA
|
|---|
| 516 | FIRSTI = .TRUE.
|
|---|
| 517 | IFINET = 0
|
|---|
| 518 | IFINNU = 0
|
|---|
| 519 | IFINKA = 0
|
|---|
| 520 | IFINPI = 0
|
|---|
| 521 | IFINHY = 0
|
|---|
| 522 | ELAST = 0.D0
|
|---|
| 523 |
|
|---|
| 524 | C RESET COUNTERS FOR NUCLEON, PION AND KAON TABLE FOR SHOWER
|
|---|
| 525 | C RESET ENERGY-MULTIPLICITY & ENERGY-ELASTICITY MATRIX FOR SHOWER
|
|---|
| 526 | DO 11 J = 1,37
|
|---|
| 527 | INBIN(J) = 0
|
|---|
| 528 | IPBIN(J) = 0
|
|---|
| 529 | IKBIN(J) = 0
|
|---|
| 530 | IHBIN(J) = 0
|
|---|
| 531 | ELMEAN(J) = 0.D0
|
|---|
| 532 | DO 11 L = 1,13
|
|---|
| 533 | MULTMA(J,L) = 0
|
|---|
| 534 | IELDPM(J,L) = 0
|
|---|
| 535 | 11 CONTINUE
|
|---|
| 536 |
|
|---|
| 537 | DO 12 J = 1,10
|
|---|
| 538 | PBAL(J) = 0.D0
|
|---|
| 539 | EBAL(J) = 0.D0
|
|---|
| 540 | 12 CONTINUE
|
|---|
| 541 |
|
|---|
| 542 | C INITIALIZE PARTICLE STACK
|
|---|
| 543 | CALL ISTACK
|
|---|
| 544 | C RESET STACKINT
|
|---|
| 545 | DO J=1,MAXICOUNT
|
|---|
| 546 | DO K=1,MAXLEN
|
|---|
| 547 | STACKINT(J,K) = 0.D0
|
|---|
| 548 | ENDDO
|
|---|
| 549 | ENDDO
|
|---|
| 550 |
|
|---|
| 551 | C INITIALIZE EVENT HEADER AND END FOR EACH EVENT
|
|---|
| 552 | DO 2123 L = 2,43
|
|---|
| 553 | EVTH(L) = 0.
|
|---|
| 554 | 2123 CONTINUE
|
|---|
| 555 | DO 123 L = 2,MAXBUF
|
|---|
| 556 | EVTE(L) = 0.
|
|---|
| 557 | 123 CONTINUE
|
|---|
| 558 |
|
|---|
| 559 | C SHOWER BEGIN PRINTOUT
|
|---|
| 560 | IF ( FPRINT .OR. DEBUG ) WRITE(MONIOU,105) SHOWNO
|
|---|
| 561 | 105 FORMAT ('1',10('='),' SHOWER NO ',I10,' ',47('=')/)
|
|---|
| 562 |
|
|---|
| 563 | C RANDOM GENERATOR STATUS AT BEGINNING OF SHOWER CALCULATION
|
|---|
| 564 | EVTH(13) = NSEQ
|
|---|
| 565 | DO 45 L = 1,NSEQ
|
|---|
| 566 | CALL RMMAQ( ISEED(1,L), L, 'R' )
|
|---|
| 567 | C SEED
|
|---|
| 568 | EVTH(11+L*3) = ISEED(1,L)
|
|---|
| 569 | C NUMBER OF CALLS
|
|---|
| 570 | EVTH(12+L*3) = MOD ( ISEED(2,L), 1000000 )
|
|---|
| 571 | C NUMBER OF MILLIONS
|
|---|
| 572 | EVTH(13+L*3) = ISEED(3,L)*1000 + INT( ISEED(2,L)/1000000 )
|
|---|
| 573 | 45 CONTINUE
|
|---|
| 574 | IF ( FPRINT .OR. DEBUG .OR. MOD(ISHW-1,IPROUT).EQ.0 ) THEN
|
|---|
| 575 | CALL PRTIME(TTIME)
|
|---|
| 576 | WRITE(MONIOU,158) SHOWNO,(L,(ISEED(J,L),J=1,3),L=1,NSEQ)
|
|---|
| 577 | 158 FORMAT(' AND RANDOM NUMBER GENERATOR AT BEGIN OF EVENT :',I8,
|
|---|
| 578 | * /,(' SEQUENCE = ',I2,' SEED = ',I9 ,' CALLS = ',I9,
|
|---|
| 579 | * ' BILLIONS = ',I9))
|
|---|
| 580 | ENDIF
|
|---|
| 581 | C RESET KNOR
|
|---|
| 582 | KNOR = .TRUE.
|
|---|
| 583 |
|
|---|
| 584 | C GET FULL RANDOM GENERATOR STATUS (103 WORDS PER SEQUENCE)
|
|---|
| 585 | CC DO 495 L = 1,NSEQ
|
|---|
| 586 | CC CALL RMMAQ( ISEED(1,L), L, 'RV' )
|
|---|
| 587 | CC WRITE(MONIOU,658) L,(ISEED(J,L),J=1,103)
|
|---|
| 588 | CC658 FORMAT ( ' FULL RANDOM NUMBER GENERATOR STATUS ',
|
|---|
| 589 | CC * 'FOR SEQUENCE ',I2,/(' ',10I11))
|
|---|
| 590 | CC495 CONTINUE
|
|---|
| 591 |
|
|---|
| 592 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 593 | c>> *** ATENTION *** ATENTION *** ATENTION *** ATENTION *** ATENTION >>
|
|---|
| 594 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 595 | c>> >>
|
|---|
| 596 | c>> In the next block (between this ATENTION comments) CORSIKA makes >>
|
|---|
| 597 | c>> three things, in this order: >>
|
|---|
| 598 | c>> >>
|
|---|
| 599 | c>> i. Set ANGLES OF INCIDENCE (different distributions of theta >>
|
|---|
| 600 | c>> for gammas -flat- and hadrons -standard. >>
|
|---|
| 601 | c>> ii. Set HEIGHT for start at THICK0 (normally = 0 => 112.8 Km) >>
|
|---|
| 602 | c>> iii. Set ENERGY of the primary. >>
|
|---|
| 603 | c>> >>
|
|---|
| 604 | c>> (The original order was ii., iii. and i.) >>
|
|---|
| 605 | c>> >>
|
|---|
| 606 | c>> JCG Wed Sep 21 10:49:14 MET DST 1998 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 607 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 608 |
|
|---|
| 609 |
|
|---|
| 610 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 611 | C GET PRIMARY ANGLES OF INCIDENCE
|
|---|
| 612 | IF ( FIXINC ) THEN
|
|---|
| 613 |
|
|---|
| 614 | THETAP = THETPR(1)
|
|---|
| 615 | PHIP = PHIPR(1)
|
|---|
| 616 | PRMPAR(3) = COS(THETAP)
|
|---|
| 617 |
|
|---|
| 618 | ELSE
|
|---|
| 619 |
|
|---|
| 620 | if ( prmpar(1).eq.1 ) then
|
|---|
| 621 |
|
|---|
| 622 | C>> GAMMAS >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 623 | C NOTE!! We will use a FLAT distribution for THETA:
|
|---|
| 624 | C Then, next block (original block) must be commented.
|
|---|
| 625 | c The modificated code follows this block
|
|---|
| 626 | c
|
|---|
| 627 | CALL RMMAR( RD,3,1 )
|
|---|
| 628 | CT1 = THETPR(1)
|
|---|
| 629 | CT2 = THETPR(2)
|
|---|
| 630 | THETAP = RD(2)*(CT2 - CT1) + CT1
|
|---|
| 631 | CTT = COS(THETAP)
|
|---|
| 632 | PRMPAR(3) = CTT
|
|---|
| 633 |
|
|---|
| 634 | else
|
|---|
| 635 |
|
|---|
| 636 | C>> HADRONS AND ELECTRONS (AND ANY OTHER BUT GAMMAS) >>>>>>>>>>>>>>>>
|
|---|
| 637 | c Choose angles at random with equal flux for all directions
|
|---|
| 638 | c with horizontal detector array (see: O.C. Allkofer & P.K.F. Grieder,
|
|---|
| 639 | c Cosmic Rays on Earth, in: Physics Data 25/1, H.Behrens & G.Ebel Ed.,
|
|---|
| 640 | c (Fachinformationszentrum Karlsruhe, Germany, 1983) chpt. 1.1.2)
|
|---|
| 641 | c
|
|---|
| 642 | CALL RMMAR( RD,3,1 )
|
|---|
| 643 | CT1 = SIN(THETPR(1))**2
|
|---|
| 644 | CT2 = SIN(THETPR(2))**2
|
|---|
| 645 | CTT = SQRT( 1.D0 - RD(2)*(CT2 - CT1) - CT1 )
|
|---|
| 646 | PRMPAR(3) = CTT
|
|---|
| 647 | THETAP = ACOS(CTT)
|
|---|
| 648 |
|
|---|
| 649 | endif
|
|---|
| 650 |
|
|---|
| 651 | PHIP = RD(1) * ( PHIPR(2) - PHIPR(1) ) + PHIPR(1)
|
|---|
| 652 |
|
|---|
| 653 | ENDIF
|
|---|
| 654 | PRMPAR(4) = PHIP
|
|---|
| 655 |
|
|---|
| 656 |
|
|---|
| 657 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 658 | C DEFINE HEIGHT FOR START AT THICK0 (IN G/CM**2) (112.8 KM FOR THICK0=0)
|
|---|
| 659 | PRMPAR(5) = HEIGH(THICK0)
|
|---|
| 660 |
|
|---|
| 661 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 662 | C GET PRIMARY ENERGY INTO PRMPAR(2)
|
|---|
| 663 | IF ( ISPEC .EQ. 0 ) THEN
|
|---|
| 664 | PRMPAR(2) = LLIMIT
|
|---|
| 665 | ELSE
|
|---|
| 666 | CALL RMMAR( RD,1,1 )
|
|---|
| 667 | IF ( PSLOPE .NE. -1.D0 ) THEN
|
|---|
| 668 | PRMPAR(2) = ( RD(1)*UL + ( 1.D0-RD(1) )*LL )**SLEX
|
|---|
| 669 | ELSE
|
|---|
| 670 | PRMPAR(2) = LLIMIT * LL**RD(1)
|
|---|
| 671 | ENDIF
|
|---|
| 672 | ENDIF
|
|---|
| 673 |
|
|---|
| 674 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 675 | c>> *** ATENTION *** ATENTION *** ATENTION *** ATENTION *** ATENTION >>
|
|---|
| 676 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 677 |
|
|---|
| 678 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 679 | c>> Modification: this is no longer needed >>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 680 | c>> (Superseeded by Sphere algorithm, see cerenkov.f) >>>>>>>>>>>>>>>>>
|
|---|
| 681 | c>> JCG Wed Sep 21 10:49:14 MET DST 1998 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 682 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 683 | C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 684 | cc Btw, we now modify the "shadow area" of the telescopes,
|
|---|
| 685 | cc to cover the angle theta.
|
|---|
| 686 | c do 160 i=1,nctels
|
|---|
| 687 | c ctpars(i,ctdiam) = ctdiams(i)/cos(thetap)
|
|---|
| 688 | c write (MONIOU,*)
|
|---|
| 689 | c * 'New region for CT',i,' = ',ctpars(i,ctdiam)
|
|---|
| 690 | c 160 continue
|
|---|
| 691 | C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 692 |
|
|---|
| 693 | C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 694 | c Here we calculate the angles spinphi and spinthe, which are the
|
|---|
| 695 | c phi and theta angles of the particle, with respect to the direction
|
|---|
| 696 | c where the CT is pointing to. spinthe is the angular displacement
|
|---|
| 697 | c of the new direction respect to the original (CT); spinphi=0 means
|
|---|
| 698 | c that the new direction is towards the zenith, spinphi=+-180 means
|
|---|
| 699 | c towards the horizont.
|
|---|
| 700 | c See the document "simulation.tex"
|
|---|
| 701 |
|
|---|
| 702 | c First, save the "CT" orientation
|
|---|
| 703 | c (moved from a couple of lines below, marked with [*])
|
|---|
| 704 | EVTH(11) = THETAP
|
|---|
| 705 | EVTH(12) = PHIP
|
|---|
| 706 |
|
|---|
| 707 | CALL RMMAR( RD,3,1 )
|
|---|
| 708 |
|
|---|
| 709 | c Then, calculate the new direction relative to the CT direction
|
|---|
| 710 | spinphi = RD(1)*PI
|
|---|
| 711 | spinthe = RD(2)*spinxi*pi/180
|
|---|
| 712 |
|
|---|
| 713 | c And then, RE-calculate the GLOBAL direction in CORSIKA
|
|---|
| 714 | c We use formulae for spherical triangles
|
|---|
| 715 | theprim = acos( cos(THETAP)*cos(spinthe)+
|
|---|
| 716 | $ sin(THETAP)*sin(spinthe)*cos(spinphi) )
|
|---|
| 717 | phiprim = asin( sin(spinthe)*sin(spinphi)/sin(theprim) )
|
|---|
| 718 | THETAP = theprim
|
|---|
| 719 | EVTH(140) = spinthe
|
|---|
| 720 | if (RD(3).gt.0.5) then
|
|---|
| 721 | PHIP = PHIP - phiprim
|
|---|
| 722 | EVTH(141) = -spinphi
|
|---|
| 723 | else
|
|---|
| 724 | PHIP = PHIP + phiprim
|
|---|
| 725 | EVTH(141) = spinphi
|
|---|
| 726 | endif
|
|---|
| 727 | PRMPAR(3) = COS(THETAP)
|
|---|
| 728 | PRMPAR(4) = PHIP
|
|---|
| 729 |
|
|---|
| 730 | C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 731 |
|
|---|
| 732 |
|
|---|
| 733 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 734 | c>> Modification (HZA trick) cancelled >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 735 | c>> JCG Wed Sep 21 10:49:14 MET DST 1998 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 736 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 737 | C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 738 | C Modificacion hecha por Aitor
|
|---|
| 739 | c aitoth = THETAP
|
|---|
| 740 | C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 741 |
|
|---|
| 742 | C CALCULATE COORDINATE CORRECTION FOR TOP OF ATMOSPHERE
|
|---|
| 743 | CALL COORIN( PRMPAR(5) )
|
|---|
| 744 |
|
|---|
| 745 | C COUNTER FOR PARTICLE OUTPUT
|
|---|
| 746 | LH = 0
|
|---|
| 747 | C COUNTER FOR CERENKOV OUTPUT
|
|---|
| 748 | IF ( LCERFI ) LHCER = 0
|
|---|
| 749 | C CALCULATE BUNCH SIZE FOR CERENKOV PHOTONS IF NOT SET IN DATAC
|
|---|
| 750 | IF ( ICRSIZ .EQ. 0 ) THEN
|
|---|
| 751 | CALL GETBUS( NINT(PRMPAR(1)),SNGL(PRMPAR(2)),SNGL(PRMPAR(3)),
|
|---|
| 752 | * CERSIZ )
|
|---|
| 753 | WRITE(MONIOU,*)'CERENKOV BUNCH SIZE IS CALCULATED TO=',CERSIZ
|
|---|
| 754 | ENDIF
|
|---|
| 755 | C GET GAMMA FACTOR FROM ENERGY
|
|---|
| 756 | C FOR GAMMAS PRMPAR(2) STAYS = ENERGY
|
|---|
| 757 | IF ( PRMPAR(1) .NE. 1.D0 )
|
|---|
| 758 | * PRMPAR(2) = PRMPAR(2) / PAMA(NINT(PRMPAR(1)))
|
|---|
| 759 |
|
|---|
| 760 | C SET PRIMARY TO CURRENT PARTICLE
|
|---|
| 761 | DO 3 J = 1,8
|
|---|
| 762 | CURPAR(J) = PRMPAR(J)
|
|---|
| 763 | NCOUN(J) = 0
|
|---|
| 764 | 3 CONTINUE
|
|---|
| 765 | C SET WEIGHT
|
|---|
| 766 |
|
|---|
| 767 | C CALCULATE FIRST INTERACTION POINT IF HADRONIC
|
|---|
| 768 | GEN = 0.D0
|
|---|
| 769 |
|
|---|
| 770 | H = HEIGH(THICK0)
|
|---|
| 771 | CALL BOX2
|
|---|
| 772 | IF ( FIX1I ) THEN
|
|---|
| 773 | CHI = THICK(FIXHEI) / PRMPAR(3)
|
|---|
| 774 | H = FIXHEI
|
|---|
| 775 | FDECAY = .FALSE.
|
|---|
| 776 | ELSE
|
|---|
| 777 | H = HEIGH ( CHI*PRMPAR(3) + THICK0 )
|
|---|
| 778 | ENDIF
|
|---|
| 779 | CHISUM = CHISUM + CHI
|
|---|
| 780 | CHISM2 = CHISM2 + CHI**2
|
|---|
| 781 | ALEVEL = H
|
|---|
| 782 | C INITIALIZE COORDINATE CORRECTIONS FOR HADRONIC PRIMARIES
|
|---|
| 783 | C FOR EM PRIMARIES IT IS DONE IN EGS
|
|---|
| 784 | HH = MAX( H, 0.D0 )
|
|---|
| 785 | IF ( CURPAR(1) .GT. 3.D0 ) CALL COORIN( HH )
|
|---|
| 786 |
|
|---|
| 787 | IF ( FMUADD ) THEN
|
|---|
| 788 | IF ( CURPAR(1) .EQ. 5 .OR. CURPAR(1) .EQ. 6) THEN
|
|---|
| 789 | DO J = 1,MAXLEN
|
|---|
| 790 | AMUPAR(J) = CURPAR(J)
|
|---|
| 791 | ENDDO
|
|---|
| 792 | AMUPAR(5) = PRMPAR(5)
|
|---|
| 793 | IF(DEBUG)WRITE(MDEBUG,*)'MAIN : MUON STORED IN AMUPAR'
|
|---|
| 794 | FMUORG = .TRUE.
|
|---|
| 795 | ENDIF
|
|---|
| 796 | ENDIF
|
|---|
| 797 |
|
|---|
| 798 | C SET TARGET FLAG IF SELECTED FOR FIRST INTERACTION
|
|---|
| 799 | IF ( N1STTR .GT. 0 ) THEN
|
|---|
| 800 | FIXTAR = .TRUE.
|
|---|
| 801 | FDECAY = .FALSE.
|
|---|
| 802 | EVTH(6) = REAL(N1STTR)
|
|---|
| 803 | ELSE
|
|---|
| 804 | FIXTAR = .FALSE.
|
|---|
| 805 | EVTH(6) = 0.0
|
|---|
| 806 | ENDIF
|
|---|
| 807 |
|
|---|
| 808 | C INITIALIZE ARRAYS FOR NKG FOR EACH SHOWER
|
|---|
| 809 | IF ( FNKG ) CALL STANKG
|
|---|
| 810 |
|
|---|
| 811 | C STORE FIRST PARTICLE IN HEADER AND PRINT IT OUT
|
|---|
| 812 | EVTH( 2) = REAL(SHOWNO)
|
|---|
| 813 | EVTH( 3) = CURPAR(1)
|
|---|
| 814 | IF ( CURPAR(1) .EQ. 1.D0 ) THEN
|
|---|
| 815 | C PRIMARY ENERGY FOR PHOTONS
|
|---|
| 816 | E00 = GAMMA
|
|---|
| 817 | E00PN = GAMMA
|
|---|
| 818 | INUCL = 1
|
|---|
| 819 | ELSE
|
|---|
| 820 | E00 = GAMMA * PAMA(NINT(CURPAR(1)))
|
|---|
| 821 | INUCL = INT(MAX(1.D0,CURPAR(1)/100.D0))
|
|---|
| 822 | E00PN = E00 / INUCL
|
|---|
| 823 | ENDIF
|
|---|
| 824 | EVTH(147) = 0.
|
|---|
| 825 |
|
|---|
| 826 | IF ( FEGS ) THEN
|
|---|
| 827 | C PARAMETER FOR ELECTRON AND PHOTON REJECT (CONVERT ENERGY TO MEV)
|
|---|
| 828 | EONCUT = .5E-9*SQRT(E00*1000.D0)
|
|---|
| 829 | CUTLN = LOG(EONCUT)
|
|---|
| 830 | ENDIF
|
|---|
| 831 | EVTH( 4) = E00
|
|---|
| 832 | EVTH( 5) = THICK0
|
|---|
| 833 | EVTH( 7) = H
|
|---|
| 834 | PTOT0 = SQRT( E00**2 - PAMA(NINT(CURPAR(1)))**2 )
|
|---|
| 835 | PTOT0N = PTOT0 / INUCL
|
|---|
| 836 | ST = SQRT(1.D0-COSTHE**2)
|
|---|
| 837 | EVTH( 8) = PTOT0 * ST * COS(PHI)
|
|---|
| 838 | EVTH( 9) = PTOT0 * ST * SIN(PHI)
|
|---|
| 839 | EVTH(10) = PTOT0 * COSTHE
|
|---|
| 840 | c
|
|---|
| 841 | c [*] one block from here sent above
|
|---|
| 842 | c
|
|---|
| 843 | EVTH(85) = CERSIZ
|
|---|
| 844 |
|
|---|
| 845 | IF ( CURPAR(1) .GT. 3.D0 ) THEN
|
|---|
| 846 | IF ( FPRINT .OR. DEBUG ) WRITE(MONIOU,102) (CURPAR(J),J = 1,8)
|
|---|
| 847 | 102 FORMAT (/' PRIMARY PARAMETERS AT FIRST INTERACTION POINT'/
|
|---|
| 848 | * 16X,1P,8E10.3)
|
|---|
| 849 | ELSE
|
|---|
| 850 | IF ( FPRINT .OR. DEBUG ) WRITE(MONIOU,132)
|
|---|
| 851 | 132 FORMAT (/' PRIMARY PARTICLE IS ELECTROMAGNETIC')
|
|---|
| 852 | ENDIF
|
|---|
| 853 |
|
|---|
| 854 | C WRITE EVENT HEADER INTO BUFFER
|
|---|
| 855 | C FOR EM PARTICLES EVTH IS WRITTEN TO BUFFER IN EGS (IF ACTIVE)
|
|---|
| 856 | IF ( EVTH(3) .GT. 3.0 .OR. .NOT. FEGS ) THEN
|
|---|
| 857 | CALL TOBUF ( EVTH,0 )
|
|---|
| 858 | IF ( LCERFI ) CALL TOBUFC( EVTH,0 )
|
|---|
| 859 | ENDIF
|
|---|
| 860 |
|
|---|
| 861 | C PRINT HEADER FOR HIGH ENERGY PARTICLES
|
|---|
| 862 | IF ( FPRINT .OR. DEBUG ) WRITE(MONIOU,103)
|
|---|
| 863 | 103 FORMAT(/' TYPE GAMMA COSTHETA ',
|
|---|
| 864 | * ' PHI HEIGHT TIME X-CM Y-CM ',
|
|---|
| 865 | * ' GEN LEVEL E ON STACK'/)
|
|---|
| 866 | NOPART = 0
|
|---|
| 867 |
|
|---|
| 868 |
|
|---|
| 869 | IF ( CURPAR(1) .LE. 3.D0 .OR.
|
|---|
| 870 | * (CURPAR(1) .GE. 5.D0 .AND. CURPAR(1) .LE. 7.D0) ) THEN
|
|---|
| 871 | C GIVE PARTICLE TO EGS OR NKG IF ELECTROMAGNETIC
|
|---|
| 872 | C AND TAKE THEN NEXT PARTICLE FROM STACK
|
|---|
| 873 | C FLAG FOR NO PRIMARY INTERACTION IS SET FOR ALL BUT ELM. PRIMARIES
|
|---|
| 874 | IF ( CURPAR(1) .LE. 3.D0 ) THEN
|
|---|
| 875 | FNPRIM = .FALSE.
|
|---|
| 876 | ELSE
|
|---|
| 877 | FNPRIM = .TRUE.
|
|---|
| 878 | H = PRMPAR(5)
|
|---|
| 879 | ENDIF
|
|---|
| 880 | CALL BOX3
|
|---|
| 881 | IF ( FEGS ) THEN
|
|---|
| 882 | CHISUM = CHISUM + THICK(DBLE(EVTH(7)))
|
|---|
| 883 | CHISM2 = CHISM2 + THICK(DBLE(EVTH(7)))**2
|
|---|
| 884 | ENDIF
|
|---|
| 885 | FIRSTI = .FALSE.
|
|---|
| 886 | GOTO 4
|
|---|
| 887 |
|
|---|
| 888 | ELSE
|
|---|
| 889 | C HADRONIC PARTICLES
|
|---|
| 890 | FNPRIM = .TRUE.
|
|---|
| 891 |
|
|---|
| 892 | C FILL LONGITUDINAL DISTRIBUTION FOR THE PRIMARY PARTICLE
|
|---|
| 893 | C THE PARTICLE IS TRACKED FROM THICK0 DOWN TO THICK0+CHI*PRMPAR(3)
|
|---|
| 894 | C COUNT THE PARTICLES FOR THE LONGITUDINAL DEVELOPMENT
|
|---|
| 895 | IF ( LLONGI ) THEN
|
|---|
| 896 | LPCT1 = INT( THICK0 * THSTPI )
|
|---|
| 897 | LPCT2 = INT( (THICK0 + PRMPAR(3)*CHI) * THSTPI )
|
|---|
| 898 | LPCT2 = MIN(NSTEP,LPCT2)
|
|---|
| 899 | C GAMMAS, ELECTRONS AND POSITRONS ARE NOT TRANSPORTED HERE, SEE EGS
|
|---|
| 900 | C MUONS ARE TRANSPORTED IN MUTRAC
|
|---|
| 901 | C HADRONS
|
|---|
| 902 | IF ( ITYPE .GE. 7 .AND. ITYPE .LE. 41 ) THEN
|
|---|
| 903 | DO 5004 L = LPCT1,LPCT2
|
|---|
| 904 | PLONG(L,6) = PLONG(L,6) + 1.
|
|---|
| 905 | 5004 CONTINUE
|
|---|
| 906 | C CHARGED HADRONS
|
|---|
| 907 | IF ( SIGNUM(ITYPE) .NE. 0.D0 ) THEN
|
|---|
| 908 | DO 5005 L = LPCT1,LPCT2
|
|---|
| 909 | PLONG(L,7) = PLONG(L,7) + 1.
|
|---|
| 910 | 5005 CONTINUE
|
|---|
| 911 | ENDIF
|
|---|
| 912 | C NUCLEI
|
|---|
| 913 | ELSEIF ( ITYPE .GT. 100 ) THEN
|
|---|
| 914 | DO 5006 L = LPCT1,LPCT2
|
|---|
| 915 | PLONG(L,8) = PLONG(L,8) + 1.
|
|---|
| 916 | 5006 CONTINUE
|
|---|
| 917 | ENDIF
|
|---|
| 918 | ENDIF
|
|---|
| 919 |
|
|---|
| 920 | C CHECK OBSERVATION LEVEL PASSAGE AND UPDATE PARTICLE COORDINATES
|
|---|
| 921 | HNEW = H
|
|---|
| 922 | C FOR UPDATE WE NEED THE START ALTITUDE H
|
|---|
| 923 | H = HEIGH(THICK0)
|
|---|
| 924 | DO 251 J = 1,NOBSLV
|
|---|
| 925 | C JUMP INTO NORMAL PARTICLE TREATMENT FOR HADRONS
|
|---|
| 926 | IF ( HNEW .GT. OBSLEV(J) ) THEN
|
|---|
| 927 | H = HNEW
|
|---|
| 928 | GOTO 6
|
|---|
| 929 | ENDIF
|
|---|
| 930 | IF ( H .LT. OBSLEV(J) ) GOTO 251
|
|---|
| 931 | C REMEMBER NUMBER OF LEVEL FOR OUTPUT
|
|---|
| 932 | LEVL = J
|
|---|
| 933 | CALL UPDATE( OBSLEV(J),THCKOB(J),J )
|
|---|
| 934 | IF (DEBUG) WRITE(MDEBUG,256) J,IRET1,IRET2
|
|---|
| 935 | 256 FORMAT(' MAIN : LEVEL ',I5,' IRET1,2=',2I5)
|
|---|
| 936 | C IF PARTICLE IS NOT CUTTED, BRING IT TO OUTPUT
|
|---|
| 937 | IF ( IRET2 .EQ. 0 ) THEN
|
|---|
| 938 | CALL OUTPUT
|
|---|
| 939 | ENDIF
|
|---|
| 940 | 251 CONTINUE
|
|---|
| 941 | IF (DEBUG) WRITE(MDEBUG,*)
|
|---|
| 942 | * 'MAIN : PRIMARY REACHED LOWEST OBSERVATION LEVEL'
|
|---|
| 943 | GOTO 4
|
|---|
| 944 | ENDIF
|
|---|
| 945 |
|
|---|
| 946 | C-----------------------------------------------------------------------
|
|---|
| 947 | C NORMAL CYCLE
|
|---|
| 948 | 7 CONTINUE
|
|---|
| 949 |
|
|---|
| 950 | C IF ENERGY TOO SMALL TAKE NEXT PARTICLE
|
|---|
| 951 | IF ( GAMMA .LE. 1.D0 ) THEN
|
|---|
| 952 | IF ( CURPAR(1) .NE. 1.D0 ) THEN
|
|---|
| 953 | IF ( CURPAR(1).EQ.5.D0 .OR. CURPAR(1).EQ.6.D0 )
|
|---|
| 954 | * FMUORG = .FALSE.
|
|---|
| 955 | GOTO 4
|
|---|
| 956 | ENDIF
|
|---|
| 957 | C SPECIAL TREATMENT FOR PHOTONS
|
|---|
| 958 | ITYPE = 1
|
|---|
| 959 | CHI = 0.D0
|
|---|
| 960 | GOTO 5
|
|---|
| 961 | ENDIF
|
|---|
| 962 |
|
|---|
| 963 | C DETERMINE PLACE OF NEXT INTERACTION
|
|---|
| 964 | CALL BOX2
|
|---|
| 965 |
|
|---|
| 966 | C CHECK PASSAGE THROUGH OBSERVATION LEVELS AND TRACK PARTICLES TO THE
|
|---|
| 967 | C PLACE OF INTERACTION
|
|---|
| 968 | 5 CONTINUE
|
|---|
| 969 | IRET1 = 0
|
|---|
| 970 | CALL BOX3
|
|---|
| 971 | IF ( IRET1 .NE. 0 ) GOTO 4
|
|---|
| 972 |
|
|---|
| 973 | 6 CONTINUE
|
|---|
| 974 | IRET1 = 0
|
|---|
| 975 | MSMM = 0
|
|---|
| 976 |
|
|---|
| 977 | C INCREMENT PARTICLE GENERATION AND PROCESS NUCLEAR INTERACTION
|
|---|
| 978 | GEN = GEN + 1.D0
|
|---|
| 979 | C INITIALIZE INTERMEDIATE STACK FOR ONE REACTION
|
|---|
| 980 | CALL TSTINI
|
|---|
| 981 | CALL NUCINT
|
|---|
| 982 | C TRANSFER INTERMEDIATE STACK FOR ONE REACTION
|
|---|
| 983 | CALL TSTEND
|
|---|
| 984 |
|
|---|
| 985 | C ENERGY - MULTIPLICITY STATISTICS
|
|---|
| 986 | IF ( EKINL .LE. 0.1D0 ) THEN
|
|---|
| 987 | MEN = 1
|
|---|
| 988 | ELSE
|
|---|
| 989 | MEN = 4.D0 + 3.D0 * LOG10(EKINL)
|
|---|
| 990 | MEN = MIN( MEN, 37 )
|
|---|
| 991 | ENDIF
|
|---|
| 992 | IF ( MSMM .LE. 1 ) THEN
|
|---|
| 993 | MMU = 1
|
|---|
| 994 | ELSE
|
|---|
| 995 | MMU = 1.D0 + 3.D0 * LOG10(DBLE(MSMM))
|
|---|
| 996 | MMU = MIN( MMU, 13 )
|
|---|
| 997 | ENDIF
|
|---|
| 998 | MULTMA(MEN,MMU) = MULTMA(MEN,MMU) + 1
|
|---|
| 999 | MULTOT(MEN,MMU) = MULTOT(MEN,MMU) + 1
|
|---|
| 1000 | IF ( DEBUG ) WRITE(MDEBUG,*) 'MAIN : EKINL,MSMM=',
|
|---|
| 1001 | * SNGL(EKINL),MSMM
|
|---|
| 1002 |
|
|---|
| 1003 | IF ( IRET1 .EQ. 0 ) THEN
|
|---|
| 1004 | IF ( DEBUG ) WRITE(MDEBUG,666) (CURPAR(II),II=1,11)
|
|---|
| 1005 | 666 FORMAT(' MAIN : CURPAR=',1P,11E10.3)
|
|---|
| 1006 | GOTO 7
|
|---|
| 1007 | ENDIF
|
|---|
| 1008 |
|
|---|
| 1009 | C GET NEXT PARTICLE FROM STACK, IF IRET=1 ALL PARTICLES ARE DONE
|
|---|
| 1010 | 4 CONTINUE
|
|---|
| 1011 | IRET1 = 0
|
|---|
| 1012 | CALL FSTACK
|
|---|
| 1013 | IF ( FMUADD ) THEN
|
|---|
| 1014 | IF ( (CURPAR(1) .EQ. 5 .OR. CURPAR(1) .EQ. 6)
|
|---|
| 1015 | * .AND. IRET1 .EQ. 0 .AND. .NOT. FMUORG ) THEN
|
|---|
| 1016 | DO J = 1,MAXLEN
|
|---|
| 1017 | AMUPAR(J) = CURPAR(J)
|
|---|
| 1018 | ENDDO
|
|---|
| 1019 | IF(DEBUG)WRITE(MDEBUG,*)'MAIN : MUON STORED IN AMUPAR'
|
|---|
| 1020 | FMUORG = .TRUE.
|
|---|
| 1021 | ENDIF
|
|---|
| 1022 | ENDIF
|
|---|
| 1023 |
|
|---|
| 1024 | IF ( IRET1 .EQ. 0 ) GOTO 7
|
|---|
| 1025 |
|
|---|
| 1026 | C-----------------------------------------------------------------------
|
|---|
| 1027 | C FINISH SHOWER AND PRINT INFORMATION
|
|---|
| 1028 | CALL OUTEND
|
|---|
| 1029 |
|
|---|
| 1030 |
|
|---|
| 1031 | * IF ( DEBUG ) WRITE(MDEBUG,442) NPARTO
|
|---|
| 1032 | *442 FORMAT(' MAIN : NPARTO='/(' ',10F10.0))
|
|---|
| 1033 |
|
|---|
| 1034 | IF ( FPRINT .OR. DEBUG ) THEN
|
|---|
| 1035 | IOBSLV = MIN( 5, NOBSLV )
|
|---|
| 1036 | WRITE(MONIOU,54) (K,K=1,IOBSLV)
|
|---|
| 1037 | 54 FORMAT (/' PARTICLES AT DETECTOR LEVEL :'/
|
|---|
| 1038 | * ' FOR LEVEL ', 5I13)
|
|---|
| 1039 | WRITE(MONIOU,55) (OBSLEV(K),K=1,IOBSLV)
|
|---|
| 1040 | 55 FORMAT ( ' HEIGHT IN CM ',1P, 5E13.3/)
|
|---|
| 1041 | WRITE(MONIOU,776) 'PROTONS ',(NPROTO(K),K=1,IOBSLV)
|
|---|
| 1042 | WRITE(MONIOU,776) 'ANTIPROTONS ',(NPROTB(K),K=1,IOBSLV)
|
|---|
| 1043 | WRITE(MONIOU,776) 'NEUTRONS ',(NNEUTR(K),K=1,IOBSLV)
|
|---|
| 1044 | WRITE(MONIOU,776) 'ANTINEUTRONS ',(NNEUTB(K),K=1,IOBSLV)
|
|---|
| 1045 | WRITE(MONIOU,776) 'PHOTONS ',(NPHOTO(K),K=1,IOBSLV)
|
|---|
| 1046 | WRITE(MONIOU,776) 'ELECTRONS ',(NELECT(K),K=1,IOBSLV)
|
|---|
| 1047 | WRITE(MONIOU,776) 'POSITRONS ',(NPOSIT(K),K=1,IOBSLV)
|
|---|
| 1048 | WRITE(MONIOU,776) 'NEUTRINOS ',(NNU (K),K=1,IOBSLV)
|
|---|
| 1049 | WRITE(MONIOU,776) 'MU - ',(NMUM (K),K=1,IOBSLV)
|
|---|
| 1050 | WRITE(MONIOU,776) 'MU + ',(NMUP (K),K=1,IOBSLV)
|
|---|
| 1051 | WRITE(MONIOU,776) 'PI 0 ',(NPI0 (K),K=1,IOBSLV)
|
|---|
| 1052 | WRITE(MONIOU,776) 'PI - ',(NPIM (K),K=1,IOBSLV)
|
|---|
| 1053 | WRITE(MONIOU,776) 'PI + ',(NPIP (K),K=1,IOBSLV)
|
|---|
| 1054 | WRITE(MONIOU,776) 'K0L ',(NK0L (K),K=1,IOBSLV)
|
|---|
| 1055 | WRITE(MONIOU,776) 'K0S ',(NK0S (K),K=1,IOBSLV)
|
|---|
| 1056 | WRITE(MONIOU,776) 'K - ',(NKMI (K),K=1,IOBSLV)
|
|---|
| 1057 | WRITE(MONIOU,776) 'K + ',(NKPL (K),K=1,IOBSLV)
|
|---|
| 1058 | WRITE(MONIOU,776) 'STR. BARYONS ',(NHYP (K),K=1,IOBSLV)
|
|---|
| 1059 | WRITE(MONIOU,776) 'DEUTERONS ',(NDEUT (K),K=1,IOBSLV)
|
|---|
| 1060 | WRITE(MONIOU,776) 'TRITONS ',(NTRIT (K),K=1,IOBSLV)
|
|---|
| 1061 | WRITE(MONIOU,776) 'ALPHAS ',(NALPHA(K),K=1,IOBSLV)
|
|---|
| 1062 | WRITE(MONIOU,776) 'OTHER PARTIC.',(NOTHER(K),K=1,IOBSLV)
|
|---|
| 1063 | WRITE(MONIOU,*)
|
|---|
| 1064 | WRITE(MONIOU,776) 'DECAYED MUONS',MUOND
|
|---|
| 1065 | 776 FORMAT(' NO OF ',A13, '= ',5F13.0)
|
|---|
| 1066 |
|
|---|
| 1067 | IF ( NOBSLV .GT. 5 ) THEN
|
|---|
| 1068 | IOBSLV = NOBSLV
|
|---|
| 1069 | WRITE(MONIOU,54) (K,K=6,IOBSLV)
|
|---|
| 1070 | WRITE(MONIOU,55) (OBSLEV(K),K=6,IOBSLV)
|
|---|
| 1071 | WRITE(MONIOU,776) 'PROTONS ',(NPROTO(K),K=6,IOBSLV)
|
|---|
| 1072 | WRITE(MONIOU,776) 'ANTIPROTONS ',(NPROTB(K),K=6,IOBSLV)
|
|---|
| 1073 | WRITE(MONIOU,776) 'NEUTRONS ',(NNEUTR(K),K=6,IOBSLV)
|
|---|
| 1074 | WRITE(MONIOU,776) 'ANTINEUTRONS ',(NNEUTB(K),K=6,IOBSLV)
|
|---|
| 1075 | WRITE(MONIOU,776) 'PHOTONS ',(NPHOTO(K),K=6,IOBSLV)
|
|---|
| 1076 | WRITE(MONIOU,776) 'ELECTRONS ',(NELECT(K),K=6,IOBSLV)
|
|---|
| 1077 | WRITE(MONIOU,776) 'POSITRONS ',(NPOSIT(K),K=6,IOBSLV)
|
|---|
| 1078 | WRITE(MONIOU,776) 'NEUTRINOS ',(NNU (K),K=6,IOBSLV)
|
|---|
| 1079 | WRITE(MONIOU,776) 'MU - ',(NMUM (K),K=6,IOBSLV)
|
|---|
| 1080 | WRITE(MONIOU,776) 'MU + ',(NMUP (K),K=6,IOBSLV)
|
|---|
| 1081 | WRITE(MONIOU,776) 'PI 0 ',(NPI0 (K),K=6,IOBSLV)
|
|---|
| 1082 | WRITE(MONIOU,776) 'PI - ',(NPIM (K),K=6,IOBSLV)
|
|---|
| 1083 | WRITE(MONIOU,776) 'PI + ',(NPIP (K),K=6,IOBSLV)
|
|---|
| 1084 | WRITE(MONIOU,776) 'K0L ',(NK0L (K),K=6,IOBSLV)
|
|---|
| 1085 | WRITE(MONIOU,776) 'K0S ',(NK0S (K),K=6,IOBSLV)
|
|---|
| 1086 | WRITE(MONIOU,776) 'K - ',(NKMI (K),K=6,IOBSLV)
|
|---|
| 1087 | WRITE(MONIOU,776) 'K + ',(NKPL (K),K=6,IOBSLV)
|
|---|
| 1088 | WRITE(MONIOU,776) 'STR. BARYONS ',(NHYP (K),K=6,IOBSLV)
|
|---|
| 1089 | WRITE(MONIOU,776) 'DEUTERONS ',(NDEUT (K),K=6,IOBSLV)
|
|---|
| 1090 | WRITE(MONIOU,776) 'TRITONS ',(NTRIT (K),K=6,IOBSLV)
|
|---|
| 1091 | WRITE(MONIOU,776) 'ALPHAS ',(NALPHA(K),K=6,IOBSLV)
|
|---|
| 1092 | WRITE(MONIOU,776) 'OTHER PARTIC.',(NOTHER(K),K=6,IOBSLV)
|
|---|
| 1093 | WRITE(MONIOU,*)
|
|---|
| 1094 | ENDIF
|
|---|
| 1095 | ENDIF
|
|---|
| 1096 |
|
|---|
| 1097 | C ADD UP FOR MEAN VALUES
|
|---|
| 1098 | DO 779 K = 1,25
|
|---|
| 1099 | DO 779 J = 1,10
|
|---|
| 1100 | MPARTO(J,K) = MPARTO(J,K) + NPARTO(J,K)
|
|---|
| 1101 | MPART2(J,K) = MPART2(J,K) + NPARTO(J,K)**2
|
|---|
| 1102 | 779 CONTINUE
|
|---|
| 1103 | EVTE(2) = SHOWNO
|
|---|
| 1104 | DO 335 K = 1,NOBSLV
|
|---|
| 1105 | EVTE(3) = EVTE(3) + NPHOTO(K)
|
|---|
| 1106 | EVTE(4) = EVTE(4) + NELECT(K) + NPOSIT(K)
|
|---|
| 1107 | EVTE(5) = EVTE(5) + NPROTO(K) + NPROTB(K) + NNEUTR(K) +
|
|---|
| 1108 | * NNEUTB(K) + NPI0(K) + NPIM(K) + NPIP(K) + NK0L(K) +
|
|---|
| 1109 | * NK0S(K) + NKMI(K) + NKPL(K) + NHYP(K) +
|
|---|
| 1110 | * NDEUT(K) + NTRIT(K) + NALPHA(K) + NOTHER(K)
|
|---|
| 1111 | EVTE(6) = EVTE(6) + NMUP(K) + NMUM(K)
|
|---|
| 1112 | 335 CONTINUE
|
|---|
| 1113 | EVTE(7) = NOPART
|
|---|
| 1114 |
|
|---|
| 1115 | IF ( FPRINT .OR. DEBUG ) WRITE(MONIOU,110)
|
|---|
| 1116 | * IFINNU,IFINPI,IFINET,IFINKA,IFINHY,
|
|---|
| 1117 | * IFINNU+IFINPI+IFINET+IFINKA+IFINHY,ELAST
|
|---|
| 1118 | 110 FORMAT(/' NO OF NUCLEONS PRODUCED IN FIRST INTERACTION =',I10/
|
|---|
| 1119 | * ' NO OF PIONS PRODUCED IN FIRST INTERACTION =',I10/
|
|---|
| 1120 | * ' NO OF ETAS PRODUCED IN FIRST INTERACTION =',I10/
|
|---|
| 1121 | * ' NO OF KAONS PRODUCED IN FIRST INTERACTION =',I10/
|
|---|
| 1122 | * ' NO OF S.BARYONS PRODUCED IN FIRST INTERACTION =',I10/
|
|---|
| 1123 | * ' TOTAL MULTIPLICITY OF FIRST INTERACTION =',I10/
|
|---|
| 1124 | * ' ELASTICITY OF FIRST INTERACTION =',F10.4)
|
|---|
| 1125 |
|
|---|
| 1126 | C PRINT OUT NKG RESULT FOR ONE SHOWER IF SELECTED
|
|---|
| 1127 | IF ( FNKG ) CALL AVAGE
|
|---|
| 1128 |
|
|---|
| 1129 | IF ( LLONGI ) THEN
|
|---|
| 1130 | C TREAT LONGITUDINAL DISTRIBUTIONS
|
|---|
| 1131 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 1132 | c calculated here again, 'cos it's rewrite I dont know where
|
|---|
| 1133 | LPCT1 = INT( THICK0 * THSTPI )
|
|---|
| 1134 | LPCT2 = INT( (THICK0 + PRMPAR(3)*CHI) * THSTPI )
|
|---|
| 1135 | LPCT2 = MIN(NSTEP,LPCT2)
|
|---|
| 1136 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 1137 | DO 980 J = LPCT1,NSTEP
|
|---|
| 1138 | C ADD ELECTRONS, POSITRONS, MUONS AND NUCLEI TO THE CHARGED PARTICLES
|
|---|
| 1139 | PLONG(J,7) = PLONG(J,7) + PLONG(J,2) + PLONG(J,3)
|
|---|
| 1140 | * + PLONG(J,4) + PLONG(J,5) + PLONG(J,8)
|
|---|
| 1141 | C ADD UP FOR MEAN VALUES OF LONGITUDINAL DISTRIBUTION
|
|---|
| 1142 | DO 979 K = 1,9
|
|---|
| 1143 | APLONG(J,K) = APLONG(J,K) + PLONG(J,K)
|
|---|
| 1144 | SPLONG(J,K) = SPLONG(J,K) + PLONG(J,K)**2
|
|---|
| 1145 | 979 CONTINUE
|
|---|
| 1146 | 980 CONTINUE
|
|---|
| 1147 |
|
|---|
| 1148 | C PRINT LONGITUDINAL DISTRIBUTIONS PER SHOWER
|
|---|
| 1149 | IF ( FPRINT .OR. DEBUG ) WRITE(MONIOU,910) THSTEP,
|
|---|
| 1150 | * 'GAMMAS','POSITRONS','ELECTRONS','MU-','MU+','HADRONS',
|
|---|
| 1151 | * 'CHARGED','NUCLEI','CERENKOV',
|
|---|
| 1152 | * (J*THSTEP,(PLONG(J,K),K=1,9),J=LPCT1,NSTEP)
|
|---|
| 1153 | 910 FORMAT(/' ---------- LONGITUDINAL DISTRIBUTION IN STEPS OF ',
|
|---|
| 1154 | * F5.0,' G/CM**2 ----------------'/
|
|---|
| 1155 | * ' DEPTH ',3A12,3A11,A12,A11,A12/
|
|---|
| 1156 | * (' ',F6.0,F13.0,2F12.0,3F11.0,F12.0,F11.0,1P,E12.5,0P) )
|
|---|
| 1157 | CJOK ADAPTED FOR HEAT CALCULATION
|
|---|
| 1158 | C910 FORMAT(/
|
|---|
| 1159 | C * ' LONGITUDINAL DISTRIBUTION IN STEPS OF ',F5.0,' G/CM**2'
|
|---|
| 1160 | C * /' ',92('=')/' DEPTH',8A10,A12/1P
|
|---|
| 1161 | C * (' ',0P,F6.0,1P,9E11.4))
|
|---|
| 1162 | CJOK
|
|---|
| 1163 |
|
|---|
| 1164 | IF ( FLGFIT ) THEN
|
|---|
| 1165 | C PERFORM FIT TO THE LONGITUDINAL DISTRIBUTION OF ALL CHARGED PARTICLES
|
|---|
| 1166 | C IF EGS IS SELECTED THIS IS THE DISTRIBUTION WHICH IS TO BE TAKEN
|
|---|
| 1167 | IF ( FEGS ) THEN
|
|---|
| 1168 | DO 930 J=0,NSTEP-LPCT1
|
|---|
| 1169 | DEP(J+1) = (J+LPCT1)*THSTEP
|
|---|
| 1170 | CHAPAR(J+1) = PLONG(J+LPCT1,7)
|
|---|
| 1171 | 930 CONTINUE
|
|---|
| 1172 | NSTP = NSTEP + 1 - LPCT1
|
|---|
| 1173 | WRITE(MONIOU,8229) 'ALL CHARGED PARTICLES'
|
|---|
| 1174 | 8229 FORMAT(/' FIT OF THE CURVE ',
|
|---|
| 1175 | * ' N(T) = P1*((T-P2)/(P3-P2))**((P3-T)/(P4+P5*T+P6*T**2))'/
|
|---|
| 1176 | * ' TO LONGITUDINAL DISTRIBUTION OF ',A35)
|
|---|
| 1177 | C IF NKG IS SELECTED ONLY THE ELECTRON DISTRIBUTION IS AVAILABLE
|
|---|
| 1178 | ELSEIF ( FNKG ) THEN
|
|---|
| 1179 | DEP(1) = 0.D0
|
|---|
| 1180 | CHAPAR(1) = 0.D0
|
|---|
| 1181 | DO 931 J = 1,IALT(1)
|
|---|
| 1182 | DEP(J+1) = TLEV(J)
|
|---|
| 1183 | CHAPAR(J+1) = SL(J)
|
|---|
| 1184 | 931 CONTINUE
|
|---|
| 1185 | NSTP = IALT(1) + 1
|
|---|
| 1186 | WRITE(MONIOU,8229) 'NKG ELECTRONS'
|
|---|
| 1187 | C IF NONE IS SELECTED IT DOES NOT REALLY MAKE SENSE TO FIT
|
|---|
| 1188 | C BUT LET'S TAKE THEN ALL CHARGED WHICH ARE MUONS AND HADRONS
|
|---|
| 1189 | ELSE
|
|---|
| 1190 | DO 932 J=0,NSTEP-LPCT1
|
|---|
| 1191 | DEP(J+1) = (J+LPCT1)*THSTEP
|
|---|
| 1192 | CHAPAR(J+1) = PLONG(J+LPCT1,7)
|
|---|
| 1193 | 932 CONTINUE
|
|---|
| 1194 | NSTP = NSTEP + 1 - LPCT1
|
|---|
| 1195 | WRITE(MONIOU,8229) 'MUONS AND CHARGED HADRONS'
|
|---|
| 1196 | ENDIF
|
|---|
| 1197 | IF ( NSTP .GT. 6 ) THEN
|
|---|
| 1198 | C THERE ARE MORE THAN 6 STEP VALUES, A FIT SHOULD BE POSSIBLE.
|
|---|
| 1199 | C DO THE FIT: NPAR AND FPARAM GIVE THE NUMBER OF PARAMETERS USED
|
|---|
| 1200 | C AND THE FINAL VALUES FOR THE PARAMETERS. CHISQ GIVES THE CHI**2/DOF
|
|---|
| 1201 | C FOR THE FIT.
|
|---|
| 1202 | CALL LONGFT(FPARAM,CHI2)
|
|---|
| 1203 | WRITE(MONIOU,8230) FPARAM,CHI2,CHI2/SQRT(FPARAM(1))*100.D0
|
|---|
| 1204 | 8230 FORMAT(' PARAMETERS = ',1P,6E12.4,0P/
|
|---|
| 1205 | * ' CHI**2/DOF = ',F10.1/
|
|---|
| 1206 | * ' AV. DEVIATION IN % = ',F10.4)
|
|---|
| 1207 | C STORE RESULT IN END EVENT BLOCK
|
|---|
| 1208 | DO 933 K = 1,6
|
|---|
| 1209 | EVTE(255+K) = FPARAM(K)
|
|---|
| 1210 | 933 CONTINUE
|
|---|
| 1211 | EVTE(262) = CHI2
|
|---|
| 1212 | ELSE
|
|---|
| 1213 | WRITE(MONIOU,*) 'NO LONGI. FIT POSSIBLE, ',
|
|---|
| 1214 | * ' NSTP = ',NSTP,' TOO SMALL.'
|
|---|
| 1215 | DO 934 K = 1,6
|
|---|
| 1216 | EVTE(255+K) = 0.
|
|---|
| 1217 | 934 CONTINUE
|
|---|
| 1218 | EVTE(262) = 0.
|
|---|
| 1219 | ENDIF
|
|---|
| 1220 | ENDIF
|
|---|
| 1221 | ENDIF
|
|---|
| 1222 |
|
|---|
| 1223 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 1224 | c Saves statistics to sta###### file
|
|---|
| 1225 | call jcstadata(EVTH,EVTE,
|
|---|
| 1226 | + NPROTO,NPROTB,NNEUTR,NNEUTB,NPHOTO,NELECT,NPOSIT,
|
|---|
| 1227 | + NNU ,NMUM ,NMUP ,NPI0 ,NPIM ,NPIP ,NK0L ,
|
|---|
| 1228 | + NK0S ,NKMI ,NKPL ,NHYP ,NDEUT ,NTRIT ,NALPHA,
|
|---|
| 1229 | + NOTHER,IFINNU,IFINPI,IFINET,IFINKA,IFINHY,
|
|---|
| 1230 | + CERELE,CERHAD,PLONG,LPCT1,NSTEP,THSTEP)
|
|---|
| 1231 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 1232 |
|
|---|
| 1233 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 1234 | C WRITE SHOWER END TO OUTPUT BUFFER
|
|---|
| 1235 | c CALL TOBUF( EVTE,0 )
|
|---|
| 1236 | CALL TOBUF( EVTE,1 )
|
|---|
| 1237 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 1238 | IF ( LCERFI ) THEN
|
|---|
| 1239 | CALL OUTND2
|
|---|
| 1240 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 1241 | c CALL TOBUFC( EVTE,0 )
|
|---|
| 1242 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 1243 | ENDIF
|
|---|
| 1244 |
|
|---|
| 1245 | IF ( FPRINT .OR. DEBUG ) WRITE(MONIOU,*)
|
|---|
| 1246 | * 'CERENKOV PH. FROM ELECTRONS = ',SNGL(CERELE),
|
|---|
| 1247 | * ' CERENKOV PH. FROM HADRONS = ',SNGL(CERHAD)
|
|---|
| 1248 | CERELE = 0.D0
|
|---|
| 1249 | CERHAD = 0.D0
|
|---|
| 1250 | NRECER = 0
|
|---|
| 1251 |
|
|---|
| 1252 | IF ( FPRINT .OR. DEBUG ) WRITE(MONIOU,210) SHOWNO
|
|---|
| 1253 | 210 FORMAT(/' END OF SHOWER NO ',I10)
|
|---|
| 1254 |
|
|---|
| 1255 | DO 19 J = 1,37
|
|---|
| 1256 | JNBIN(J) = JNBIN(J) + INBIN(J)
|
|---|
| 1257 | JPBIN(J) = JPBIN(J) + IPBIN(J)
|
|---|
| 1258 | JKBIN(J) = JKBIN(J) + IKBIN(J)
|
|---|
| 1259 | JHBIN(J) = JHBIN(J) + IHBIN(J)
|
|---|
| 1260 | 19 CONTINUE
|
|---|
| 1261 |
|
|---|
| 1262 | 2 CONTINUE
|
|---|
| 1263 | C END OF SHOWER LOOP
|
|---|
| 1264 |
|
|---|
| 1265 | C-----------------------------------------------------------------------
|
|---|
| 1266 | 992 CONTINUE
|
|---|
| 1267 |
|
|---|
| 1268 | C RESET NUMBER OF SHOWERS TO CORRECT VALUE
|
|---|
| 1269 | ISHW = I
|
|---|
| 1270 |
|
|---|
| 1271 | RUNE(3) = REAL(ISHW)
|
|---|
| 1272 | C WRITE RUN END TO OUTPUT BUFFER AND FINISH OUTPUT
|
|---|
| 1273 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 1274 | c CALL TOBUF ( RUNE,1 )
|
|---|
| 1275 | call jcendrun(rune)
|
|---|
| 1276 | c IF ( LCERFI ) CALL TOBUFC( RUNE,1 )
|
|---|
| 1277 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 1278 | C TIME SINCE BEGINNING
|
|---|
| 1279 | c ILEFTB = TIME()
|
|---|
| 1280 | ILEFTB = 1
|
|---|
| 1281 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 1282 | TDIFF = ILEFTB - ILEFTA
|
|---|
| 1283 |
|
|---|
| 1284 | C MEAN VALUE FOR FIRST INTERACTION ALTITUDE (G/CM**2)
|
|---|
| 1285 | IF ( ISHW .GT. 1 ) THEN
|
|---|
| 1286 | CHISM2 = SQRT( ABS(CHISM2-CHISUM**2/ISHW) / (ISHW-1) )
|
|---|
| 1287 | CHISUM = CHISUM / ISHW
|
|---|
| 1288 | ELSE
|
|---|
| 1289 | CHISM2 = 0.D0
|
|---|
| 1290 | ENDIF
|
|---|
| 1291 |
|
|---|
| 1292 | C OUTPUTS FOR ALL SHOWERS
|
|---|
| 1293 | WRITE(MONIOU,201) ISHW,TDIFF,TDIFF/ISHW,IRECOR,IRECOR/ISHW,
|
|---|
| 1294 | * CHISUM,CHISM2
|
|---|
| 1295 | 201 FORMAT('1',10('='),' RUN SUMMARY ',56('=')//
|
|---|
| 1296 | * ' NUMBER OF GENERATED EVENTS = ',I10,/
|
|---|
| 1297 | * ' TOTAL TIME USED = ',E10.3,' SEC'/
|
|---|
| 1298 | * ' TIME PER EVENT = ',E10.3,' SEC'/
|
|---|
| 1299 | * ' TOTAL SPACE ON PATAPE USED = ',I10,' WORDS'/
|
|---|
| 1300 | * ' SPACE PER EVENT ON PATAPE = ',I10,' WORDS'/
|
|---|
| 1301 | * ' AVERAGE HEIGHT OF 1ST INT. = ',F10.3,' +-',F10.3,' G/CM**2'/)
|
|---|
| 1302 |
|
|---|
| 1303 | C ENERGY - MULTIPLICITY MATRIX FOR ALL SHOWERS
|
|---|
| 1304 | WRITE(MONIOU,209) (K,K=1,13),
|
|---|
| 1305 | * (J,(MULTOT(J,K),K=1,13),10**((J-4.)/3.),10**((J-3.)/3.),J=1,37),
|
|---|
| 1306 | * 1,(INT(10**((K-1.)/3.)+1),K = 2,13),
|
|---|
| 1307 | * 2,(INT(10**((K )/3.) ),K = 2,13)
|
|---|
| 1308 | 209 FORMAT(//' ENERGY - MULTIPLICITY MATRIX FOR ALL SHOWERS'/
|
|---|
| 1309 | * ' ENERGY RUNS VERTICALLY, MULTIPLICITY HORIZONTALLY'//,
|
|---|
| 1310 | * ' ',6X,5I9,3I8,5I7,' ENERGY RANGE (GEV)'/
|
|---|
| 1311 | * 37(/' ',I4,1X,I10,4I9,3I8,5I7,1X,1P,2E10.1,0P)//
|
|---|
| 1312 | * ' MULT. ',5I9,3I8,5I7,4X,'LOWER BIN LIMIT'/
|
|---|
| 1313 | * ' RANGE ',5I9,3I8,5I7,4X,'UPPER BIN LIMIT')
|
|---|
| 1314 |
|
|---|
| 1315 | C GET MEAN OF ELASTICITY FOR ENERGY BINS
|
|---|
| 1316 | DO 3377 J = 1,37
|
|---|
| 1317 | NELMEA = 0
|
|---|
| 1318 | DO 3378 K = 1,10
|
|---|
| 1319 | NELMEA = NELMEA + IELDPA(J,K)
|
|---|
| 1320 | 3378 CONTINUE
|
|---|
| 1321 | IF ( NELMEA .NE. 0 ) ELMEAA(J) = ELMEAA(J) / NELMEA
|
|---|
| 1322 | 3377 CONTINUE
|
|---|
| 1323 |
|
|---|
| 1324 | C PRINT ENERGY - ELASTICITY MATRIX FOR ALL SHOWERS
|
|---|
| 1325 | WRITE(MONIOU,408) (K,K=1,10), (J,(IELDPA(J,K),K=1,10),
|
|---|
| 1326 | * ELMEAA(J),10**((J-4.D0)/3.D0),10**((J-3.)/3.D0),J=1,37),
|
|---|
| 1327 | * ((K-1)*0.1D0,K=1,10),(K*0.1D0,K=1,10)
|
|---|
| 1328 | 408 FORMAT (//' ENERGY - ELASTICITY MATRIX FOR ALL SHOWERS'/
|
|---|
| 1329 | * ' ENERGY RUNS VERTICALLY, ELASTICITY HORIZONTALLY'//
|
|---|
| 1330 | * ' ',5X,10I9,' MEAN EL. ENERGY RANGE (GEV)'/
|
|---|
| 1331 | * 37(/' ',I4,1X,10I9,2X,1P,E10.3,2E10.1,0P)//
|
|---|
| 1332 | * ' ELA. ',10F9.2,5X,'LOWER BIN LIMIT'/
|
|---|
| 1333 | * ' RANGE',10F9.2,5X,'UPPER BIN LIMIT')
|
|---|
| 1334 |
|
|---|
| 1335 | WRITE(MONIOU,204)
|
|---|
| 1336 | 204 FORMAT (//' INTERACTIONS PER KINETIC ENERGY INTERVAL FOR ALL ',
|
|---|
| 1337 | * 'SHOWERS'//' BIN LOWER LIMIT UPPER LIMIT ',
|
|---|
| 1338 | * 'NUCLEON PIONS KAONS S.BARYONS TOTAL'/
|
|---|
| 1339 | * 12X,'IN GEV',9X,'IN GEV',7X,
|
|---|
| 1340 | * ' EVENTS EVENTS EVENTS EVENTS '//)
|
|---|
| 1341 | WRITE(MONIOU,207) (I,SABIN(I),SBBIN(I),JNBIN(I),JPBIN(I),JKBIN(I)
|
|---|
| 1342 | * ,JHBIN(I),JNBIN(I)+JPBIN(I)+JKBIN(I)+JHBIN(I),I=1,37)
|
|---|
| 1343 | 207 FORMAT(' ',I5,1P,2E15.4,0P,I12,3I10,I11)
|
|---|
| 1344 |
|
|---|
| 1345 | IF ( .NOT.GHEISH ) THEN
|
|---|
| 1346 | C PRINT ELASTICITY STATISTICS
|
|---|
| 1347 | WRITE(MONIOU,89) (I,(I-1)*.05,I*.05,
|
|---|
| 1348 | * IELIS(I),IELHM(I),IELNU(I),IELPI(I),I = 1,20)
|
|---|
| 1349 | 89 FORMAT (//' ELASTICITY STATISTICS '//
|
|---|
| 1350 | * ' BIN LOW HIGH EDGE FOR ISOBARS HEAVY MESONS',
|
|---|
| 1351 | * ' SINGLE NUCLEONS AND PIONS'/
|
|---|
| 1352 | * (' ',I3,' ',F4.2,' ',F4.2,' ',4I17))
|
|---|
| 1353 | ENDIF
|
|---|
| 1354 |
|
|---|
| 1355 | C CALCULATE MEAN VALUES AND STANDARD DEVIATIONS OF PARTICLE NUMBERS
|
|---|
| 1356 | IF ( ISHW .GT. 1 ) THEN
|
|---|
| 1357 | DO 879 K = 1,25
|
|---|
| 1358 | DO 879 J = 1,NOBSLV
|
|---|
| 1359 | MPART2(J,K) = SQRT( abs(MPART2(J,K)-MPARTO(J,K)**2/ISHW)
|
|---|
| 1360 | * /(ISHW-1) )
|
|---|
| 1361 | MPARTO(J,K) = MPARTO(J,K)/ISHW
|
|---|
| 1362 | 879 CONTINUE
|
|---|
| 1363 | ELSE
|
|---|
| 1364 | DO 880 K = 1,25
|
|---|
| 1365 | DO 880 J = 1,NOBSLV
|
|---|
| 1366 | MPART2(J,K) = 0.D0
|
|---|
| 1367 | 880 CONTINUE
|
|---|
| 1368 | ENDIF
|
|---|
| 1369 |
|
|---|
| 1370 | C PRINT MEAN VALUES AND STANDARD DEVIATIONS OF PARTICLE NUMBERS
|
|---|
| 1371 | IOBSLV = MIN( 3, NOBSLV )
|
|---|
| 1372 | WRITE(MONIOU,854) (K,K=1,IOBSLV)
|
|---|
| 1373 | 854 FORMAT (/ ' AVERAGE NUMBER OF PARTICLES PER EVENT :'/
|
|---|
| 1374 | * ' FROM LEVEL NUMBER ', 3(10X,I10,10X) )
|
|---|
| 1375 | WRITE(MONIOU,855) (OBSLEV(K),K=1,IOBSLV)
|
|---|
| 1376 | 855 FORMAT ( ' HEIGHT IN CM',1P,3(20X,E10.3)/)
|
|---|
| 1377 |
|
|---|
| 1378 | WRITE(MONIOU,778)'PROTONS ',(MPROTO(K),MPROT2(K),K=1,IOBSLV)
|
|---|
| 1379 | WRITE(MONIOU,778)'ANTIPROTONS ',(MPROTB(K),MPRTB2(K),K=1,IOBSLV)
|
|---|
| 1380 | WRITE(MONIOU,778)'NEUTRONS ',(MNEUTR(K),MNETR2(K),K=1,IOBSLV)
|
|---|
| 1381 | WRITE(MONIOU,778)'ANTINEUTRONS',(MNEUTB(K),MNETB2(K),K=1,IOBSLV)
|
|---|
| 1382 | WRITE(MONIOU,778)'PHOTONS ',(MPHOTO(K),MPHOT2(K),K=1,IOBSLV)
|
|---|
| 1383 | WRITE(MONIOU,778)'ELECTRONS ',(MELECT(K),MELEC2(K),K=1,IOBSLV)
|
|---|
| 1384 | WRITE(MONIOU,778)'POSITRONS ',(MPOSIT(K),MPOSI2(K),K=1,IOBSLV)
|
|---|
| 1385 | WRITE(MONIOU,778)'NEUTRINOS ',(MNU (K),MNU2 (K),K=1,IOBSLV)
|
|---|
| 1386 | WRITE(MONIOU,778)'MU - ',(MMUM (K),MMUM2 (K),K=1,IOBSLV)
|
|---|
| 1387 | WRITE(MONIOU,778)'MU + ',(MMUP (K),MMUP2 (K),K=1,IOBSLV)
|
|---|
| 1388 | WRITE(MONIOU,778)'PI 0 ',(MPI0 (K),MPI02 (K),K=1,IOBSLV)
|
|---|
| 1389 | WRITE(MONIOU,778)'PI - ',(MPIM (K),MPIM2 (K),K=1,IOBSLV)
|
|---|
| 1390 | WRITE(MONIOU,778)'PI + ',(MPIP (K),MPIP2 (K),K=1,IOBSLV)
|
|---|
| 1391 | WRITE(MONIOU,778)'K0L ',(MK0L (K),MK0L2 (K),K=1,IOBSLV)
|
|---|
| 1392 | WRITE(MONIOU,778)'K0S ',(MK0S (K),MK0S2 (K),K=1,IOBSLV)
|
|---|
| 1393 | WRITE(MONIOU,778)'K - ',(MKMI (K),MKMI2 (K),K=1,IOBSLV)
|
|---|
| 1394 | WRITE(MONIOU,778)'K + ',(MKPL (K),MKPL2 (K),K=1,IOBSLV)
|
|---|
| 1395 | WRITE(MONIOU,778)'STR. BARYONS',(MHYP (K),MHYP2 (K),K=1,IOBSLV)
|
|---|
| 1396 | WRITE(MONIOU,778)'DEUTERONS ',(MDEUT (K),MDEUT2(K),K=1,IOBSLV)
|
|---|
| 1397 | WRITE(MONIOU,778)'TRITONS ',(MTRIT (K),MTRIT2(K),K=1,IOBSLV)
|
|---|
| 1398 | WRITE(MONIOU,778)'ALPHAS ',(MALPHA(K),MALPH2(K),K=1,IOBSLV)
|
|---|
| 1399 | WRITE(MONIOU,778)'OTHER PART. ',(MOTHER(K),MOTH2 (K),K=1,IOBSLV)
|
|---|
| 1400 | WRITE(MONIOU,*)
|
|---|
| 1401 | 778 FORMAT(' NO OF ',A12,' = ',3(F13.1,' +-',F13.1,' '))
|
|---|
| 1402 |
|
|---|
| 1403 | IF ( NOBSLV .GT. 3 ) THEN
|
|---|
| 1404 | IOBSLV = MIN( 6, NOBSLV )
|
|---|
| 1405 | WRITE(MONIOU,854) (K,K=4,IOBSLV)
|
|---|
| 1406 | WRITE(MONIOU,855) (OBSLEV(K),K=4,IOBSLV)
|
|---|
| 1407 | WRITE(MONIOU,778)'PROTONS ',(MPROTO(K),MPROT2(K),K=4,IOBSLV)
|
|---|
| 1408 | WRITE(MONIOU,778)'ANTIPROTONS ',(MPROTB(K),MPRTB2(K),K=4,IOBSLV)
|
|---|
| 1409 | WRITE(MONIOU,778)'NEUTRONS ',(MNEUTR(K),MNETR2(K),K=4,IOBSLV)
|
|---|
| 1410 | WRITE(MONIOU,778)'ANTINEUTRONS',(MNEUTB(K),MNETB2(K),K=4,IOBSLV)
|
|---|
| 1411 | WRITE(MONIOU,778)'PHOTONS ',(MPHOTO(K),MPHOT2(K),K=4,IOBSLV)
|
|---|
| 1412 | WRITE(MONIOU,778)'ELECTRONS ',(MELECT(K),MELEC2(K),K=4,IOBSLV)
|
|---|
| 1413 | WRITE(MONIOU,778)'POSITRONS ',(MPOSIT(K),MPOSI2(K),K=4,IOBSLV)
|
|---|
| 1414 | WRITE(MONIOU,778)'NEUTRINOS ',(MNU (K),MNU2 (K),K=4,IOBSLV)
|
|---|
| 1415 | WRITE(MONIOU,778)'MU - ',(MMUM (K),MMUM2 (K),K=4,IOBSLV)
|
|---|
| 1416 | WRITE(MONIOU,778)'MU + ',(MMUP (K),MMUP2 (K),K=4,IOBSLV)
|
|---|
| 1417 | WRITE(MONIOU,778)'PI 0 ',(MPI0 (K),MPI02 (K),K=4,IOBSLV)
|
|---|
| 1418 | WRITE(MONIOU,778)'PI - ',(MPIM (K),MPIM2 (K),K=4,IOBSLV)
|
|---|
| 1419 | WRITE(MONIOU,778)'PI + ',(MPIP (K),MPIP2 (K),K=4,IOBSLV)
|
|---|
| 1420 | WRITE(MONIOU,778)'K0L ',(MK0L (K),MK0L2 (K),K=4,IOBSLV)
|
|---|
| 1421 | WRITE(MONIOU,778)'K0S ',(MK0S (K),MK0S2 (K),K=4,IOBSLV)
|
|---|
| 1422 | WRITE(MONIOU,778)'K - ',(MKMI (K),MKMI2 (K),K=4,IOBSLV)
|
|---|
| 1423 | WRITE(MONIOU,778)'K + ',(MKPL (K),MKPL2 (K),K=4,IOBSLV)
|
|---|
| 1424 | WRITE(MONIOU,778)'STR. BARYONS',(MHYP (K),MHYP2 (K),K=4,IOBSLV)
|
|---|
| 1425 | WRITE(MONIOU,778)'DEUTERONS ',(MDEUT (K),MDEUT2(K),K=4,IOBSLV)
|
|---|
| 1426 | WRITE(MONIOU,778)'TRITONS ',(MTRIT (K),MTRIT2(K),K=4,IOBSLV)
|
|---|
| 1427 | WRITE(MONIOU,778)'ALPHAS ',(MALPHA(K),MALPH2(K),K=4,IOBSLV)
|
|---|
| 1428 | WRITE(MONIOU,778)'OTHER PART. ',(MOTHER(K),MOTH2 (K),K=4,IOBSLV)
|
|---|
| 1429 | WRITE(MONIOU,*)
|
|---|
| 1430 |
|
|---|
| 1431 | IF ( NOBSLV .GT. 6 ) THEN
|
|---|
| 1432 | IOBSLV = MIN( 9, NOBSLV )
|
|---|
| 1433 | WRITE(MONIOU,854) (K,K=7,IOBSLV)
|
|---|
| 1434 | WRITE(MONIOU,855) (OBSLEV(K),K=7,IOBSLV)
|
|---|
| 1435 | WRITE(MONIOU,778)'PROTONS ',(MPROTO(K),MPROT2(K),K=7,IOBSLV)
|
|---|
| 1436 | WRITE(MONIOU,778)'ANTIPROTONS ',(MPROTB(K),MPRTB2(K),K=7,IOBSLV)
|
|---|
| 1437 | WRITE(MONIOU,778)'NEUTRONS ',(MNEUTR(K),MNETR2(K),K=7,IOBSLV)
|
|---|
| 1438 | WRITE(MONIOU,778)'ANTINEUTRONS',(MNEUTB(K),MNETB2(K),K=7,IOBSLV)
|
|---|
| 1439 | WRITE(MONIOU,778)'PHOTONS ',(MPHOTO(K),MPHOT2(K),K=7,IOBSLV)
|
|---|
| 1440 | WRITE(MONIOU,778)'ELECTRONS ',(MELECT(K),MELEC2(K),K=7,IOBSLV)
|
|---|
| 1441 | WRITE(MONIOU,778)'POSITRONS ',(MPOSIT(K),MPOSI2(K),K=7,IOBSLV)
|
|---|
| 1442 | WRITE(MONIOU,778)'NEUTRINOS ',(MNU (K),MNU2 (K),K=7,IOBSLV)
|
|---|
| 1443 | WRITE(MONIOU,778)'MU - ',(MMUM (K),MMUM2 (K),K=7,IOBSLV)
|
|---|
| 1444 | WRITE(MONIOU,778)'MU + ',(MMUP (K),MMUP2 (K),K=7,IOBSLV)
|
|---|
| 1445 | WRITE(MONIOU,778)'PI 0 ',(MPI0 (K),MPI02 (K),K=7,IOBSLV)
|
|---|
| 1446 | WRITE(MONIOU,778)'PI - ',(MPIM (K),MPIM2 (K),K=7,IOBSLV)
|
|---|
| 1447 | WRITE(MONIOU,778)'PI + ',(MPIP (K),MPIP2 (K),K=7,IOBSLV)
|
|---|
| 1448 | WRITE(MONIOU,778)'K0L ',(MK0L (K),MK0L2 (K),K=7,IOBSLV)
|
|---|
| 1449 | WRITE(MONIOU,778)'K0S ',(MK0S (K),MK0S2 (K),K=7,IOBSLV)
|
|---|
| 1450 | WRITE(MONIOU,778)'K - ',(MKMI (K),MKMI2 (K),K=7,IOBSLV)
|
|---|
| 1451 | WRITE(MONIOU,778)'K + ',(MKPL (K),MKPL2 (K),K=7,IOBSLV)
|
|---|
| 1452 | WRITE(MONIOU,778)'STR. BARYONS',(MHYP (K),MHYP2 (K),K=7,IOBSLV)
|
|---|
| 1453 | WRITE(MONIOU,778)'DEUTERONS ',(MDEUT (K),MDEUT2(K),K=7,IOBSLV)
|
|---|
| 1454 | WRITE(MONIOU,778)'TRITONS ',(MTRIT (K),MTRIT2(K),K=7,IOBSLV)
|
|---|
| 1455 | WRITE(MONIOU,778)'ALPHAS ',(MALPHA(K),MALPH2(K),K=7,IOBSLV)
|
|---|
| 1456 | WRITE(MONIOU,778)'OTHER PART. ',(MOTHER(K),MOTH2 (K),K=7,IOBSLV)
|
|---|
| 1457 | WRITE(MONIOU,*)
|
|---|
| 1458 |
|
|---|
| 1459 | IF ( NOBSLV .GT. 9 ) THEN
|
|---|
| 1460 | IOBSLV = MIN( 10, NOBSLV )
|
|---|
| 1461 | WRITE(MONIOU,854) (K,K=9,IOBSLV)
|
|---|
| 1462 | WRITE(MONIOU,855) (OBSLEV(K),K=9,IOBSLV)
|
|---|
| 1463 | WRITE(MONIOU,778)'PROTONS ',(MPROTO(K),MPROT2(K),K=9,IOBSLV)
|
|---|
| 1464 | WRITE(MONIOU,778)'ANTIPROTONS ',(MPROTB(K),MPRTB2(K),K=9,IOBSLV)
|
|---|
| 1465 | WRITE(MONIOU,778)'NEUTRONS ',(MNEUTR(K),MNETR2(K),K=9,IOBSLV)
|
|---|
| 1466 | WRITE(MONIOU,778)'ANTINEUTRONS',(MNEUTB(K),MNETB2(K),K=9,IOBSLV)
|
|---|
| 1467 | WRITE(MONIOU,778)'PHOTONS ',(MPHOTO(K),MPHOT2(K),K=9,IOBSLV)
|
|---|
| 1468 | WRITE(MONIOU,778)'ELECTRONS ',(MELECT(K),MELEC2(K),K=9,IOBSLV)
|
|---|
| 1469 | WRITE(MONIOU,778)'POSITRONS ',(MPOSIT(K),MPOSI2(K),K=9,IOBSLV)
|
|---|
| 1470 | WRITE(MONIOU,778)'NEUTRINOS ',(MNU (K),MNU2 (K),K=9,IOBSLV)
|
|---|
| 1471 | WRITE(MONIOU,778)'MU - ',(MMUM (K),MMUM2 (K),K=9,IOBSLV)
|
|---|
| 1472 | WRITE(MONIOU,778)'MU + ',(MMUP (K),MMUP2 (K),K=9,IOBSLV)
|
|---|
| 1473 | WRITE(MONIOU,778)'PI 0 ',(MPI0 (K),MPI02 (K),K=9,IOBSLV)
|
|---|
| 1474 | WRITE(MONIOU,778)'PI - ',(MPIM (K),MPIM2 (K),K=9,IOBSLV)
|
|---|
| 1475 | WRITE(MONIOU,778)'PI + ',(MPIP (K),MPIP2 (K),K=9,IOBSLV)
|
|---|
| 1476 | WRITE(MONIOU,778)'K0L ',(MK0L (K),MK0L2 (K),K=9,IOBSLV)
|
|---|
| 1477 | WRITE(MONIOU,778)'K0S ',(MK0S (K),MK0S2 (K),K=9,IOBSLV)
|
|---|
| 1478 | WRITE(MONIOU,778)'K - ',(MKMI (K),MKMI2 (K),K=9,IOBSLV)
|
|---|
| 1479 | WRITE(MONIOU,778)'K + ',(MKPL (K),MKPL2 (K),K=9,IOBSLV)
|
|---|
| 1480 | WRITE(MONIOU,778)'STR. BARYONS',(MHYP (K),MHYP2 (K),K=9,IOBSLV)
|
|---|
| 1481 | WRITE(MONIOU,778)'DEUTERONS ',(MDEUT (K),MDEUT2(K),K=9,IOBSLV)
|
|---|
| 1482 | WRITE(MONIOU,778)'TRITONS ',(MTRIT (K),MTRIT2(K),K=9,IOBSLV)
|
|---|
| 1483 | WRITE(MONIOU,778)'ALPHAS ',(MALPHA(K),MALPH2(K),K=9,IOBSLV)
|
|---|
| 1484 | WRITE(MONIOU,778)'OTHER PART. ',(MOTHER(K),MOTH2 (K),K=9,IOBSLV)
|
|---|
| 1485 | WRITE(MONIOU,*)
|
|---|
| 1486 | ENDIF
|
|---|
| 1487 |
|
|---|
| 1488 | ENDIF
|
|---|
| 1489 | ENDIF
|
|---|
| 1490 |
|
|---|
| 1491 | C PRINT OUT NKG RESULT FOR ALL SHOWERS IF SELECTED
|
|---|
| 1492 | IF ( FNKG ) CALL MITAGE
|
|---|
| 1493 |
|
|---|
| 1494 | C CALCULATE MEAN VALUES AND SIGMAS OF LONGITUDINAL DISTRIBUTION
|
|---|
| 1495 | IF ( LLONGI ) THEN
|
|---|
| 1496 | IF ( ISHW .GT. 1 ) THEN
|
|---|
| 1497 | DO 790 K = 1,9
|
|---|
| 1498 | DO 789 J = LPCT1,NSTEP
|
|---|
| 1499 | SPLONG(J,K) = SQRT( abs(SPLONG(J,K)-APLONG(J,K)**2/ISHW)
|
|---|
| 1500 | * /(ISHW-1) )
|
|---|
| 1501 | APLONG(J,K) = APLONG(J,K)/ISHW
|
|---|
| 1502 | 789 CONTINUE
|
|---|
| 1503 | 790 CONTINUE
|
|---|
| 1504 | ELSE
|
|---|
| 1505 | DO 990 K = 1,9
|
|---|
| 1506 | DO 989 J = LPCT1,NSTEP
|
|---|
| 1507 | SPLONG(J,K) = 0.D0
|
|---|
| 1508 | 989 CONTINUE
|
|---|
| 1509 | 990 CONTINUE
|
|---|
| 1510 | ENDIF
|
|---|
| 1511 |
|
|---|
| 1512 | C PRINT AVERAGE LONGITUDINAL DISTRIBUTIONS
|
|---|
| 1513 | WRITE(MONIOU,911) THSTEP,
|
|---|
| 1514 | * 'GAMMAS ','POSITRONS','ELECTRONS','MU- ','MU+ ',
|
|---|
| 1515 | * (J*THSTEP,(APLONG(J,K),SPLONG(J,K),K=1,5),J=LPCT1,NSTEP)
|
|---|
| 1516 | 911 FORMAT(/' AVERAGE LONGITUDINAL DISTRIBUTION IN STEPS OF ',
|
|---|
| 1517 | * F5.0,' G/CM**2 '/' ',131('=')/
|
|---|
| 1518 | * ' DEPTH',8X,3(A10,16X),A9,15X,A9 //
|
|---|
| 1519 | * (' ',F5.0,2X,1P,E11.4,'+-',E11.4,0P,1X,F12.0,'+-',F11.0,
|
|---|
| 1520 | * 1X,F12.0,'+-',E11.4,1X,F11.1,'+-',F10.1,
|
|---|
| 1521 | * 1X,F11.1,'+-',F10.1 ))
|
|---|
| 1522 | WRITE(MONIOU,912) THSTEP,
|
|---|
| 1523 | * 'HADRONS','CHARGED','NUCLEI','CERENKOV',
|
|---|
| 1524 | * (J*THSTEP,(APLONG(J,K),SPLONG(J,K),K=6,9),J=LPCT1,NSTEP)
|
|---|
| 1525 | 912 FORMAT(/' AVERAGE LONGITUDINAL DISTRIBUTION IN STEPS OF ',
|
|---|
| 1526 | * F5.0,' G/CM**2 '/' ',115('=')/
|
|---|
| 1527 | * ' DEPTH',8X,A9,16X,A10,16X,A9,21X,A9 //
|
|---|
| 1528 | * (' ',F5.0,1X,F11.1,'+-',F11.1,1X,F12.0,'+-',F12.0,
|
|---|
| 1529 | * 2X,F10.1,'+-',F10.1,1X,1P,E16.6,'+-',E16.6,0P))
|
|---|
| 1530 | ENDIF
|
|---|
| 1531 |
|
|---|
| 1532 | IF ( FLGFIT ) THEN
|
|---|
| 1533 | C PERFORM FIT TO THE LONGITUDINAL DISTRIBUTION OF ALL CHARGED PARTICLES
|
|---|
| 1534 | C IF EGS IS SELECTED THIS IS THE DISTRIBUTION WHICH IS TO BE TAKEN
|
|---|
| 1535 | IF ( FEGS ) THEN
|
|---|
| 1536 | DO 730 J=0,NSTEP-LPCT1
|
|---|
| 1537 | DEP(J+1) = (J+LPCT1)*THSTEP
|
|---|
| 1538 | CHAPAR(J+1) = APLONG(J+LPCT1,7)
|
|---|
| 1539 | 730 CONTINUE
|
|---|
| 1540 | NSTP = NSTEP + 1 - LPCT1
|
|---|
| 1541 | WRITE(MONIOU,8229) 'AVERAGE ALL CHARGED PARTICLES'
|
|---|
| 1542 | C IF NKG IS SELECTED ONLY THE ELECTRON DISTRIBUTION IS AVAILABLE
|
|---|
| 1543 | ELSEIF ( FNKG ) THEN
|
|---|
| 1544 | DEP(1) = 0.D0
|
|---|
| 1545 | CHAPAR(1) = 0.D0
|
|---|
| 1546 | DO 731 J = 1,IALT(1)
|
|---|
| 1547 | DEP(J+1) = TLEV(J)
|
|---|
| 1548 | CHAPAR(J+1) = SEL(J)/ISHW
|
|---|
| 1549 | 731 CONTINUE
|
|---|
| 1550 | NSTP = IALT(1) + 1
|
|---|
| 1551 | WRITE(MONIOU,8229) 'AVERAGE NKG ELECTRONS'
|
|---|
| 1552 | C IF NONE IS SELECTED IT DOES NOT REALLY MAKE SENSE TO FIT
|
|---|
| 1553 | C BUT LET'S TAKE THEN ALL CHARGED WHICH ARE MUONS AND HADRONS
|
|---|
| 1554 | ELSE
|
|---|
| 1555 | DO 732 J=0,NSTEP-LPCT1
|
|---|
| 1556 | DEP(J+1) = (J+LPCT1)*THSTEP
|
|---|
| 1557 | CHAPAR(J+1) = APLONG(J+LPCT1,7)
|
|---|
| 1558 | 732 CONTINUE
|
|---|
| 1559 | NSTP = NSTEP + 1 - LPCT1
|
|---|
| 1560 | WRITE(MONIOU,8229) 'AVERAGE MUONS AND CHARGED HADRONS'
|
|---|
| 1561 | ENDIF
|
|---|
| 1562 | IF ( NSTP .GT. 6 ) THEN
|
|---|
| 1563 | C THERE ARE MORE THAN 6 STEP VALUES, A FIT SHOULD BE POSSIBLE.
|
|---|
| 1564 | C DO THE FIT: NPAR AND FPARAM GIVE THE NUMBER OF PARAMETERS USED
|
|---|
| 1565 | C AND THE FINAL VALUES FOR THE PARAMETERS. CHISQ GIVES THE CHI**2/DOF
|
|---|
| 1566 | C FOR THE FIT.
|
|---|
| 1567 | CALL LONGFT(FPARAM,CHI2)
|
|---|
| 1568 | WRITE(MONIOU,8230) FPARAM,CHI2,CHI2/SQRT(FPARAM(1))*100.D0
|
|---|
| 1569 | ELSE
|
|---|
| 1570 | WRITE(MONIOU,*) 'NO LONGI. FIT POSSIBLE, ',
|
|---|
| 1571 | * ' NSTP = ',NSTP,' TOO SMALL.'
|
|---|
| 1572 | ENDIF
|
|---|
| 1573 | ENDIF
|
|---|
| 1574 |
|
|---|
| 1575 |
|
|---|
| 1576 | C CONTROL PRINT OUTPUT OF CONSTANTS
|
|---|
| 1577 | IF ( DEBUG ) THEN
|
|---|
| 1578 | CALL STAEND
|
|---|
| 1579 | WRITE(MDEBUG,*) 'MAIN : STAEND CALLED'
|
|---|
| 1580 | ENDIF
|
|---|
| 1581 |
|
|---|
| 1582 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 1583 | call jcenddata(runh,rune)
|
|---|
| 1584 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 1585 |
|
|---|
| 1586 | WRITE(MONIOU,*)' '
|
|---|
| 1587 | CALL PRTIME(TTIME)
|
|---|
| 1588 | WRITE(MONIOU,101)
|
|---|
| 1589 | 101 FORMAT (/' ',10('='),' END OF RUN ',67('='))
|
|---|
| 1590 |
|
|---|
| 1591 | C CLOSE ALL OPEN UNITS
|
|---|
| 1592 | IF ( MONIOU .NE. 6 ) CLOSE( MONIOU )
|
|---|
| 1593 | IF ( MDEBUG .NE. 6 ) CLOSE( MDEBUG )
|
|---|
| 1594 | CLOSE( EXST )
|
|---|
| 1595 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 1596 | c CLOSE( PATAPE )
|
|---|
| 1597 | c IF ( LCERFI ) CLOSE( CETAPE )
|
|---|
| 1598 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 1599 |
|
|---|
| 1600 | STOP
|
|---|
| 1601 | END
|
|---|
