source: trunk/MagicSoft/Simulation/Corsika/Mmcs/muprpr.f@ 12426

Last change on this file since 12426 was 286, checked in by harald, 25 years ago
This is the start point for further developments of the Magic Monte Carlo Simulation written by Jose Carlos Gonzales. Now it is under control of one CVS repository for the whole collaboration. Everyone should use this CVS repository for further developments.
File size: 6.1 KB
Line 
1 SUBROUTINE MUPRPR
2
3C-----------------------------------------------------------------------
4C MU(ON) P(AI)R PR(ODUCTION)
5C
6C TREATES MUON PAIR PRODUCTION (WITHOUT POLARISATION EFFECTS)
7C IN ANALOGY WITH SUBROUTINE GPAIRM FROM GEANT WRITTEN BY L. URBAN
8C EXPLANATIONS SEE CERN PROGRM LIBRARY LONG WRITEUP W5013
9C THIS SUBROUTINE IS CALLED FROM MUTRAC
10C
11C DESIGN : D. HECK IK3 FZK KARLSRUHE
12C-----------------------------------------------------------------------
13
14 IMPLICIT NONE
15*KEEP,CONST.
16 COMMON /CONST/ PI,PI2,OB3,TB3,ENEPER
17 DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
18*KEEP,ELABCT.
19 COMMON /ELABCT/ ELCUT
20 DOUBLE PRECISION ELCUT(4)
21*KEEP,GENER.
22 COMMON /GENER/ GEN,ALEVEL
23 DOUBLE PRECISION GEN,ALEVEL
24*KEEP,MUPART.
25 COMMON /MUPART/ AMUPAR,BCUT,CMUON,FMUBRM,FMUORG
26 DOUBLE PRECISION AMUPAR(14),BCUT,CMUON(11)
27 LOGICAL FMUBRM,FMUORG
28*KEEP,PAM.
29 COMMON /PAM/ PAMA,SIGNUM
30 DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
31*KEEP,PARPAR.
32 COMMON /PARPAR/ CURPAR,SECPAR,PRMPAR,OUTPAR,C,
33 * E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
34 DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
35 * C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
36 INTEGER ITYPE,LEVL
37*KEEP,PARPAE.
38 DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
39 EQUIVALENCE (CURPAR(2),GAMMA), (CURPAR(3),COSTHE),
40 * (CURPAR(4), PHI ), (CURPAR(5), H ),
41 * (CURPAR(6), T ), (CURPAR(7), X ),
42 * (CURPAR(8), Y ), (CURPAR(9), CHI ),
43 * (CURPAR(10),BETA), (CURPAR(11),GCM ),
44 * (CURPAR(12),ECM )
45*KEEP,POLAR.
46 COMMON /POLAR/ POLART,POLARF
47 DOUBLE PRECISION POLART,POLARF
48*KEEP,RANDPA.
49 COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR
50 DOUBLE PRECISION FAC,U1,U2
51 REAL RD(3000)
52 INTEGER ISEED(103,10),NSEQ
53 LOGICAL KNOR
54*KEEP,REST.
55 COMMON /REST/ CONTNE,TAR,LT
56 DOUBLE PRECISION CONTNE(3),TAR
57 INTEGER LT
58*KEEP,RUNPAR.
59 COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
60 * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
61 * MONIOU,MDEBUG,NUCNUC,
62 * CETAPE,
63 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
64 * N1STTR,MDBASE,
65 * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
66 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
67 * ,GHEISH,GHESIG
68 COMMON /RUNPAC/ DSN,HOST,USER
69 DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
70 REAL STEPFC
71 INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
72 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
73 * N1STTR,MDBASE
74 INTEGER CETAPE
75 CHARACTER*79 DSN
76 CHARACTER*20 HOST,USER
77
78 LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
79 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
80 * ,GHEISH,GHESIG
81*KEND.
82
83 DOUBLE PRECISION AA,ALE,ALFA,AL10T,A1,A1R,B,BETA1,CC,C1,C2,
84 * COSTH3,COSTH4,EKIN,EMUON,ENEG,EPOS,EPP,
85 * PHI3,PPOS,R0,R0MAX,SCREJ,SINTH3,
86 * TPOS,V,VC,VMAX,VMIN,V0,Z
87 INTEGER I
88 DATA AL10T/9.212D0/
89C-----------------------------------------------------------------------
90
91 IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
92 444 FORMAT(' MUPRPR: CURPAR=',1P,9E10.3)
93
94C COPY COORDINATES TO SECPAR
95 DO 11 I = 5,8
96 SECPAR(I) = CURPAR(I)
97 11 CONTINUE
98 SECPAR( 9) = GEN
99C SET MATERIAL CONSTANTS CMUON(.) ACCORDING TO
100C TARGET INDEX LT (1=N, 2=O, 3=AR) WHICH HAS BEEN SET IN BOX2
101 IF ( LT .EQ. 1 ) THEN
102 Z = 7.D0
103 ELSEIF ( LT .EQ. 2 ) THEN
104 Z = 8.D0
105 ELSE
106 Z = 18.D0
107 ENDIF
108C TOTAL AND KINETIC ENERGY OF MUON
109 EMUON = PAMA(5) * GAMMA
110 EKIN = EMUON - PAMA(5)
111 IF ( EKIN .LE. BCUT ) GOTO 900
112C
113 VMIN = 4.D0 * PAMA(2) / EMUON
114 VMAX = 1.D0 - CMUON(10) * Z**OB3 / EMUON
115 IF ( VMAX .LE. VMIN ) GOTO 900
116 VC = BCUT / EMUON
117 ALE = LOG(EMUON)
118 ALFA = 1.D0 + ALE/AL10T
119 V0 = 0.18D0 * (4.D0 + ALE/AL10T) * ALFA * (ALFA*VMIN)**TB3
120 BETA1 = 0.1D0 * (1.D0 + 3.D0 * ALE/AL10T)
121 B = 0.9D0 / (1.D0 + 0.4D0*ALE + 0.022D0*ALE**2)
122 AA = 1.D0 + 2.D0 * B * LOG(VC/V0)
123 IF ( AA .LE. 1.D0 ) AA = 1.05D0
124 A1 = 1.D0 - AA
125 CC = EXP(-0.25D0*A1*A1/B)
126 A1R = 1.D0 / A1
127 C1 = VMAX**A1
128 C2 = VC**A1
129C SAMPLE ENERGY FRACTION V AND RO
130 50 CALL RMMAR(RD,2,1)
131 V = ( RD(1)*C1 + (1.-RD(1))*C2 )**A1R
132 IF ( V .LE. VMIN ) GOTO 50
133 IF ( V .LT. V0 ) THEN
134 SCREJ = CC * ( (V-VMIN)/(V0-VMIN) )**BETA * (V0/V)**A1
135 ELSE
136 SCREJ = CC * (V0/V)**( A1 + B*LOG(V/V0) )
137 ENDIF
138 IF ( RD(2) .GT. SCREJ ) GOTO 50
139 R0MAX = SCREJ * ( 1.D0 - 6.D0 *PAMA(5)/( EMUON**2 * (1.D0-V) ) )
140 CALL RMMAR(RD,2,1)
141 R0 = R0MAX * (2.*RD(1)-1.)
142C ENERGIES
143 EPP = V * EMUON
144 EPOS = 0.5D0 * EPP * (1.D0 + R0)
145 ENEG = EPP - EPOS
146C ANGLES
147 COSTH3 = COS( PAMA(5)/EMUON )
148 PHI3 = PI2 * RD(2)
149C POSITRON
150 IF ( EPOS .GT. BCUT+PAMA(3) ) THEN
151 CALL ADDANG( COSTHE,PHI, COSTH3,PHI3, SECPAR(3),SECPAR(4) )
152 IF ( SECPAR(3) .GT. C(29) ) THEN
153 SECPAR( 1) = 2.D0
154 SECPAR( 2) = EPOS/PAMA(2)
155 SECPAR(10) = H
156 CALL TSTACK
157 ENDIF
158 ENDIF
159C ELECTRON
160 IF ( ENEG .GT. BCUT+PAMA(3) ) THEN
161 CALL ADDANG( COSTHE,PHI, COSTH3,-PHI3, SECPAR(3),SECPAR(4) )
162 IF ( SECPAR(3) .GT. C(29) ) THEN
163 SECPAR( 1) = 3.D0
164 SECPAR( 2) = ENEG/PAMA(2)
165 SECPAR(10) = H
166 CALL TSTACK
167 ENDIF
168 ENDIF
169C REDUCE ENERGY OF MUON
170 60 CONTINUE
171 GAMMA = (EMUON - EPP)/ PAMA(5)
172
173 900 CONTINUE
174C WRITE MUON TO STACK
175 SECPAR( 1) = CURPAR(1)
176 SECPAR( 2) = GAMMA
177 SECPAR( 3) = CURPAR(3)
178 SECPAR( 4) = CURPAR(4)
179 SECPAR(10) = ALEVEL
180 CALL TSTACK
181
182 RETURN
183 END
Note: See TracBrowser for help on using the repository browser.