| 1 | SUBROUTINE MPPROP
|
|---|
| 2 | C
|
|---|
| 3 | C*********************************************************************
|
|---|
| 4 | C DESIGN : D. HECK IK3 FZK KARLSRUHE
|
|---|
| 5 | C DATE : JUL 14, 1989
|
|---|
| 6 | C*********************************************************************
|
|---|
| 7 | C SUBROUTINE MOVES MUONS AND PIONS FROM EGS-STACK TO CORSIKA-STACK.
|
|---|
| 8 | C*********************************************************************
|
|---|
| 9 | DOUBLE PRECISION AMASS
|
|---|
| 10 | C DOUBLE PRECISION CUT
|
|---|
| 11 | *KEEP,ELABCT.
|
|---|
| 12 | COMMON /ELABCT/ ELCUT
|
|---|
| 13 | DOUBLE PRECISION ELCUT(4)
|
|---|
| 14 | *KEND.
|
|---|
| 15 | DOUBLE PRECISION PRRMMU
|
|---|
| 16 | COMMON/MUON/PRRMMU,RMMU,RMMUT2
|
|---|
| 17 | *KEEP,PARPAR.
|
|---|
| 18 | COMMON /PARPAR/ CURPAR,SECPAR,PRMPAR,OUTPAR,C,
|
|---|
| 19 | * E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
|
|---|
| 20 | DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
|
|---|
| 21 | * C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
|
|---|
| 22 | INTEGER ITYPE,LEVL
|
|---|
| 23 | *KEND.
|
|---|
| 24 | DOUBLE PRECISION PI0MSQ
|
|---|
| 25 | COMMON/PION/PI0MSQ,PITHR,PICMAS,PI0MAS,AMASK0,AMASKC,AMASPR,AMASNT
|
|---|
| 26 | *
|
|---|
| 27 | *KEEP,POLAR.
|
|---|
| 28 | COMMON /POLAR/ POLART,POLARF
|
|---|
| 29 | DOUBLE PRECISION POLART,POLARF
|
|---|
| 30 | *KEEP,RUNPAR.
|
|---|
| 31 | COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
|
|---|
| 32 | * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
|
|---|
| 33 | * MONIOU,MDEBUG,NUCNUC,
|
|---|
| 34 | * CETAPE,
|
|---|
| 35 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
|---|
| 36 | * N1STTR,MDBASE,
|
|---|
| 37 | * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
|---|
| 38 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
|---|
| 39 | * ,GHEISH,GHESIG
|
|---|
| 40 | COMMON /RUNPAC/ DSN,HOST,USER
|
|---|
| 41 | DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
|
|---|
| 42 | REAL STEPFC
|
|---|
| 43 | INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
|
|---|
| 44 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
|---|
| 45 | * N1STTR,MDBASE
|
|---|
| 46 | INTEGER CETAPE
|
|---|
| 47 | CHARACTER*79 DSN
|
|---|
| 48 | CHARACTER*20 HOST,USER
|
|---|
| 49 |
|
|---|
| 50 | LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
|---|
| 51 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
|---|
| 52 | * ,GHEISH,GHESIG
|
|---|
| 53 | *KEEP,STACKE.
|
|---|
| 54 | COMMON/STACKE/ E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
|
|---|
| 55 | DOUBLE PRECISION E(60),TIME(60)
|
|---|
| 56 | REAL X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
|
|---|
| 57 | INTEGER IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
|
|---|
| 58 | *KEND.
|
|---|
| 59 | COMMON/UPHIOT/THETA,SINTHE,COSTHE,SINPHI, COSPHI,PI,TWOPI,PI5D2
|
|---|
| 60 | COMMON/ACLOCK/NCLOCK,JCLOCK
|
|---|
| 61 | C_____IF (NCLOCK.GT.JCLOCK) THEN
|
|---|
| 62 | C______WRITE(MDEBUG,* )' MPPROP:NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
|
|---|
| 63 | C______CALL AUSGB2
|
|---|
| 64 | C_____END IF
|
|---|
| 65 | C*** SET MASS AND CUT PARAMETER OF PARTICLE UNDER CONSIDERATION
|
|---|
| 66 | IF (IQ(NP).LT.7) THEN
|
|---|
| 67 | AMASS=PRRMMU
|
|---|
| 68 | C CUT=ELCUT(2)*1000.D0
|
|---|
| 69 | ELSEIF(IQ(NP).EQ.7) THEN
|
|---|
| 70 | AMASS=PI0MAS
|
|---|
| 71 | C CUT=ELCUT(1)*1000.D0
|
|---|
| 72 | POLART=1.D0
|
|---|
| 73 | POLARF=0.D0
|
|---|
| 74 | ELSE
|
|---|
| 75 | AMASS=PICMAS
|
|---|
| 76 | C CUT=ELCUT(1)*1000.D0
|
|---|
| 77 | POLART=1.D0
|
|---|
| 78 | POLARF=0.D0
|
|---|
| 79 | END IF
|
|---|
| 80 | C*** USE PARTICLE ONLY IF ABOVE CUT AND INSIDE ACCEPTANCE CONE
|
|---|
| 81 | C IF (E(NP)-AMASS.GT.CUT .AND. W(NP).GT.C(29)) THEN
|
|---|
| 82 | IF (W(NP).GT.C(29)) THEN
|
|---|
| 83 | C *** ANGLE WITH RESPECT TO X AXIS
|
|---|
| 84 | IF (U(NP)**2+V(NP)**2.GT.3.E-38) THEN
|
|---|
| 85 | ANGLEX = -ATAN2(V(NP),U(NP))
|
|---|
| 86 | ELSE
|
|---|
| 87 | ANGLEX = 0.
|
|---|
| 88 | END IF
|
|---|
| 89 | C *** FILL MUON/PION COORDINATES INTO CORSIKA-STACK
|
|---|
| 90 | SECPAR(1)=IQ(NP)
|
|---|
| 91 | SECPAR(2)=E(NP)/AMASS
|
|---|
| 92 | SECPAR(3)=W(NP)
|
|---|
| 93 | SECPAR(4)=ANGLEX
|
|---|
| 94 | SECPAR(5)=-Z(NP)
|
|---|
| 95 | SECPAR(6)=TIME(NP)
|
|---|
| 96 | SECPAR(7)=X(NP)
|
|---|
| 97 | SECPAR(8)=-Y(NP)
|
|---|
| 98 | SECPAR(9)=IGEN(NP)
|
|---|
| 99 | SECPAR(10)=-Z(NP)
|
|---|
| 100 | SECPAR(11)=POLART
|
|---|
| 101 | SECPAR(12)=POLARF
|
|---|
| 102 | C *** ADD MUON/PION TO CORSIKA-STACK
|
|---|
| 103 | CALL TSTOUT
|
|---|
| 104 | END IF
|
|---|
| 105 | C*** ELIMINATE MUON/PION FROM EGS-STACK
|
|---|
| 106 | POLART=-POLART
|
|---|
| 107 | POLARF=POLARF+PI
|
|---|
| 108 | NP=NP-1
|
|---|
| 109 | RETURN
|
|---|
| 110 | END
|
|---|
