| 1 | SUBROUTINE SHOWER
|
|---|
| 2 | C
|
|---|
| 3 | C*********************************************************************
|
|---|
| 4 | C DESIGN : D. HECK IK3 FZK KARLSRUHE
|
|---|
| 5 | C DATE : AUG 11, 1988
|
|---|
| 6 | C*********************************************************************
|
|---|
| 7 | C THIS ROUTINE LOOKS, WHAT IS ON TOP OF STACK, AND CALLS THE
|
|---|
| 8 | C APPROPRIATE ROUTINE TO TREAT THIS PARTICLE.
|
|---|
| 9 | C*********************************************************************
|
|---|
| 10 | COMMON/MISC/KMPI,KMPO,DUNIT,NOSCAT,MED(6),RHOR(6),IRAYLR(6)
|
|---|
| 11 | *KEEP,RUNPAR.
|
|---|
| 12 | COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
|
|---|
| 13 | * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
|
|---|
| 14 | * MONIOU,MDEBUG,NUCNUC,
|
|---|
| 15 | * CETAPE,
|
|---|
| 16 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
|---|
| 17 | * N1STTR,MDBASE,
|
|---|
| 18 | * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
|---|
| 19 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
|---|
| 20 | * ,GHEISH,GHESIG
|
|---|
| 21 | COMMON /RUNPAC/ DSN,HOST,USER
|
|---|
| 22 | DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
|
|---|
| 23 | REAL STEPFC
|
|---|
| 24 | INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
|
|---|
| 25 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
|---|
| 26 | * N1STTR,MDBASE
|
|---|
| 27 | INTEGER CETAPE
|
|---|
| 28 | CHARACTER*79 DSN
|
|---|
| 29 | CHARACTER*20 HOST,USER
|
|---|
| 30 |
|
|---|
| 31 | LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
|---|
| 32 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
|---|
| 33 | * ,GHEISH,GHESIG
|
|---|
| 34 | *KEEP,STACKE.
|
|---|
| 35 | COMMON/STACKE/ E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
|
|---|
| 36 | DOUBLE PRECISION E(60),TIME(60)
|
|---|
| 37 | REAL X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
|
|---|
| 38 | INTEGER IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
|
|---|
| 39 | *KEND.
|
|---|
| 40 | C*** TAKE FIRST PARTICLE IN STACK
|
|---|
| 41 | NP=1
|
|---|
| 42 | IF((DEBUG))CALL AUSGB2
|
|---|
| 43 | 251 CONTINUE
|
|---|
| 44 | C *** DECIDE WHAT IS ON TOP OF STACK
|
|---|
| 45 | 261 CONTINUE
|
|---|
| 46 | C *** JUMP TO PARTICLE IN QUESTION
|
|---|
| 47 | C *** THE FOLLOWING PARTICLE IDENTIFICATION IS MADE BY THE
|
|---|
| 48 | C *** VALUE OF IQ(NP) (ACCORDING TO PROGRAM 'GEANT')
|
|---|
| 49 | C *** IQ = 1 PHOTON
|
|---|
| 50 | C *** = 2 POSITRON E (+)
|
|---|
| 51 | C *** = 3 ELECTRON E (-)
|
|---|
| 52 | C *** = 5 POSITIVE MUON (+)
|
|---|
| 53 | C *** = 6 NEGATIVE MUON (-)
|
|---|
| 54 | C *** = 7 NEUTRAL PION (0)
|
|---|
| 55 | C *** = 8 POSITIVE PION (+)
|
|---|
| 56 | C *** = 9 NEGATIVE PION (-)
|
|---|
| 57 | C *** IF IQ = OTHER VALUE, JUMP TO ERROR MESSAGE
|
|---|
| 58 | GO TO(270,280,280,290, 300,300,300,300,300) (IQ(NP))
|
|---|
| 59 | C *** IQ OUT OF RANGE?
|
|---|
| 60 | 290 WRITE(KMPO,320) IQ(NP)
|
|---|
| 61 | 320 FORMAT(' SHOWER: PARTICLE TYPE ',I5,' NOT IDENTIFIED')
|
|---|
| 62 | CALL AUSGB2
|
|---|
| 63 | NP=NP-1
|
|---|
| 64 | GO TO262
|
|---|
| 65 | 300 CALL MPPROP
|
|---|
| 66 | GO TO262
|
|---|
| 67 | 270 CALL PHOTON(IRCODE)
|
|---|
| 68 | C *** PHOTON DISCARDED ?
|
|---|
| 69 | IF((IRCODE.EQ.2))GO TO262
|
|---|
| 70 | IF((IQ(NP).LT.2 .OR. IQ(NP).GT.3))GO TO261
|
|---|
| 71 | 280 CALL ELECTR(IRCODE)
|
|---|
| 72 | C *** ELECTRON DISCARDED ?
|
|---|
| 73 | IF((IRCODE.EQ.2))GO TO262
|
|---|
| 74 | IF((IQ(NP).EQ.1))GO TO 270
|
|---|
| 75 | C *** LOOP BACK UP TO PARTICLE SELECTION
|
|---|
| 76 | GO TO 261
|
|---|
| 77 | 262 CONTINUE
|
|---|
| 78 | C *** CHECK TO SEE IF ANYTHING LEFT ON STACK
|
|---|
| 79 | C *** NOTHING ON STACK, SO JUMP OUT OF LOOP
|
|---|
| 80 | IF((NP.LE.0))GO TO252
|
|---|
| 81 | GO TO 251
|
|---|
| 82 | 252 CONTINUE
|
|---|
| 83 | C*** TOP STACK LOOP END
|
|---|
| 84 | RETURN
|
|---|
| 85 | END
|
|---|
