source: trunk/MagicSoft/Simulation/Corsika/Mmcs/etadec.f@ 1730

Last change on this file since 1730 was 286, checked in by harald, 26 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.3 KB
Line 
1 SUBROUTINE ETADEC
2
3C-----------------------------------------------------------------------
4C ETA DEC(AY)
5C
6C ROUTINE TREATES DECAY OF ETA
7C DECAY WITH FULL KINEMATIC, ENERGY AND MOMENTA CONSERVED
8C THIS SUBROUTINE IS CALLED FROM BOX3
9C
10C DESIGN : D. HECK IK3 FZK KARLSRUHE
11C-----------------------------------------------------------------------
12
13 IMPLICIT NONE
14*KEEP,CONST.
15 COMMON /CONST/ PI,PI2,OB3,TB3,ENEPER
16 DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
17*KEEP,DECAY.
18 COMMON /DECAY/ GAM345,COS345,PHI345
19 DOUBLE PRECISION GAM345(3),COS345(3),PHI345(3)
20*KEEP,EDECAY.
21 COMMON /EDECAY/ CETA
22 DOUBLE PRECISION CETA(5)
23*KEEP,GENER.
24 COMMON /GENER/ GEN,ALEVEL
25 DOUBLE PRECISION GEN,ALEVEL
26*KEEP,PAM.
27 COMMON /PAM/ PAMA,SIGNUM
28 DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
29*KEEP,PARPAR.
30 COMMON /PARPAR/ CURPAR,SECPAR,PRMPAR,OUTPAR,C,
31 * E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
32 DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
33 * C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
34 INTEGER ITYPE,LEVL
35*KEEP,PARPAE.
36 DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
37 EQUIVALENCE (CURPAR(2),GAMMA), (CURPAR(3),COSTHE),
38 * (CURPAR(4), PHI ), (CURPAR(5), H ),
39 * (CURPAR(6), T ), (CURPAR(7), X ),
40 * (CURPAR(8), Y ), (CURPAR(9), CHI ),
41 * (CURPAR(10),BETA), (CURPAR(11),GCM ),
42 * (CURPAR(12),ECM )
43*KEEP,RANDPA.
44 COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR
45 DOUBLE PRECISION FAC,U1,U2
46 REAL RD(3000)
47 INTEGER ISEED(103,10),NSEQ
48 LOGICAL KNOR
49*KEEP,RUNPAR.
50 COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
51 * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
52 * MONIOU,MDEBUG,NUCNUC,
53 * CETAPE,
54 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
55 * N1STTR,MDBASE,
56 * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
57 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
58 * ,GHEISH,GHESIG
59 COMMON /RUNPAC/ DSN,HOST,USER
60 DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
61 REAL STEPFC
62 INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
63 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
64 * N1STTR,MDBASE
65 INTEGER CETAPE
66 CHARACTER*79 DSN
67 CHARACTER*20 HOST,USER
68
69 LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
70 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
71 * ,GHEISH,GHESIG
72*KEND.
73
74 DOUBLE PRECISION AUX1,AUX2,COSTH1,COSTH2,EETA2,FI1
75 INTEGER I
76C-----------------------------------------------------------------------
77
78 IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
79 444 FORMAT(' ETADEC: CURPAR=',1P,9E10.3)
80
81C SELECT MODE OF DECAY, IF NOT ALREADY SELECTED BY THE PARTICLE TYPE
82 IF ( ITYPE .EQ. 17 ) THEN
83 CALL RMMAR( RD,1,1 )
84 IF ( RD(1) .LE. CETA(1) ) THEN
85 ITYPE = 71
86 ELSEIF ( RD(1) .LE. CETA(2) ) THEN
87 ITYPE = 72
88 ELSEIF ( RD(1) .LE. CETA(3) ) THEN
89 ITYPE = 73
90 ELSE
91 ITYPE = 74
92 ENDIF
93 ENDIF
94
95C COPY COORDINATES INTO SECPAR
96 DO 1 I = 5,8
97 SECPAR(I) = CURPAR(I)
98 1 CONTINUE
99 SECPAR( 9) = GEN
100 SECPAR(10) = ALEVEL
101
102C DECAY OF ETA WITH 4 MODES
103
104C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
105C DECAY ETA ----> GAMMA + GAMMA
106 IF ( ITYPE .EQ. 71 ) THEN
107 EETA2 = 0.5D0 * GAMMA * PAMA(17)
108 CALL RMMAR( RD,2,1 )
109 AUX1 = 1.D0 + BETA * RD(1)
110 AUX2 = 1.D0 - BETA * RD(1)
111 COSTH1 = (BETA + RD(1)) / AUX1
112 COSTH2 = (BETA - RD(1)) / AUX2
113
114 SECPAR(1) = 1.D0
115C FIRST GAMMA (WITH HIGHER ENERGY)
116 FI1 = PI2 * RD(2)
117 CALL ADDANG( COSTHE,PHI, COSTH1,FI1, SECPAR(3),SECPAR(4) )
118 IF ( SECPAR(3) .GT. C(29) ) THEN
119 SECPAR(2) = AUX1 * EETA2
120 CALL TSTACK
121 ENDIF
122C SECOND GAMMA (WITH LOWER ENERGY)
123 CALL ADDANG( COSTHE,PHI, COSTH2,FI1+PI, SECPAR(3),SECPAR(4) )
124 IF ( SECPAR(3) .GT. C(29) ) THEN
125 SECPAR(2) = AUX2 * EETA2
126 CALL TSTACK
127 ENDIF
128
129C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
130C DECAY ETA ----> PI(0) + PI(0) + PI(0)
131 ELSEIF ( ITYPE .EQ. 72 ) THEN
132 CALL DECAY6( PAMA(17), PAMA(7),PAMA(7),PAMA(7),
133 * 0.D0,0.D0,0.D0, 1.D0, 2 )
134 SECPAR(1) = 7.D0
135 DO 340 I = 1,3
136 CALL ADDANG( COSTHE,PHI, COS345(I),PHI345(I),
137 * SECPAR(3),SECPAR(4) )
138 IF ( SECPAR(3) .GT. C(29) ) THEN
139 SECPAR(2) = GAM345(I)
140 CALL TSTACK
141 ENDIF
142 340 CONTINUE
143
144C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
145C DECAY ETA ----> PI(-) + PI(+) + PI(0)
146 ELSEIF ( ITYPE .EQ. 73 ) THEN
147 CALL DECAY6( PAMA(17), PAMA(9),PAMA(8),PAMA(7),
148 * CETA(4),0.D0,0.D0, CETA(5), 2 )
149 DO 360 I = 1,3
150 CALL ADDANG( COSTHE,PHI, COS345(I),PHI345(I),
151 * SECPAR(3),SECPAR(4) )
152 IF ( SECPAR(3) .GT. C(29) ) THEN
153 SECPAR(1) = 10 - I
154 SECPAR(2) = GAM345(I)
155 CALL TSTACK
156 ENDIF
157 360 CONTINUE
158
159C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
160C DECAY ETA ----> PI(+) + PI(-) + GAMMA
161 ELSEIF ( ITYPE .EQ. 74 ) THEN
162 CALL DECAY6( PAMA(17), PAMA(8),PAMA(9),0.D0,
163 * 0.D0,0.D0,0.D0, 1.D0, 2 )
164 DO 380 I = 1,3
165 CALL ADDANG( COSTHE,PHI, COS345(I),PHI345(I),
166 * SECPAR(3),SECPAR(4) )
167 IF ( SECPAR(3) .GT. C(29) ) THEN
168 IF ( I .LE. 2 ) THEN
169 SECPAR(1) = 7 + I
170 ELSE
171 SECPAR(1) = 1.D0
172 ENDIF
173 SECPAR(2) = GAM345(I)
174 CALL TSTACK
175 ENDIF
176 380 CONTINUE
177
178 ELSE
179 WRITE(MONIOU,*) 'ETADEC: UNEXPECTED PARTICLE CODE ITYPE=',ITYPE
180 ENDIF
181 RETURN
182 END
Note: See TracBrowser for help on using the repository browser.