source: trunk/MagicSoft/Simulation/Corsika/Mmcs/strdec.f@ 6525

Last change on this file since 6525 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: 5.5 KB
Line 
1 SUBROUTINE STRDEC
2
3C-----------------------------------------------------------------------
4C STR(ANGE BARYON) DEC(AY)
5C
6C ROUTINE TREATES DECAY OF STRANGE BARYONS (LAMBDA, SIGMA, XI, OMEGA)
7C DECAY WITH FULL KINEMATIC, ENERGY AND MOMENTA CONSERVED
8C THIS SUBROUTINE IS CALLED FORM NUCINT
9C
10C DESIGN : D. HECK IK3 FZK KARLSRUHE
11C-----------------------------------------------------------------------
12
13 IMPLICIT NONE
14*KEEP,IRET.
15 COMMON /IRET/ IRET1,IRET2
16 INTEGER IRET1,IRET2
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*KEEP,PARPAE.
24 DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
25 EQUIVALENCE (CURPAR(2),GAMMA), (CURPAR(3),COSTHE),
26 * (CURPAR(4), PHI ), (CURPAR(5), H ),
27 * (CURPAR(6), T ), (CURPAR(7), X ),
28 * (CURPAR(8), Y ), (CURPAR(9), CHI ),
29 * (CURPAR(10),BETA), (CURPAR(11),GCM ),
30 * (CURPAR(12),ECM )
31*KEEP,RANDPA.
32 COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR
33 DOUBLE PRECISION FAC,U1,U2
34 REAL RD(3000)
35 INTEGER ISEED(103,10),NSEQ
36 LOGICAL KNOR
37*KEEP,RUNPAR.
38 COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
39 * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
40 * MONIOU,MDEBUG,NUCNUC,
41 * CETAPE,
42 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
43 * N1STTR,MDBASE,
44 * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
45 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
46 * ,GHEISH,GHESIG
47 COMMON /RUNPAC/ DSN,HOST,USER
48 DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
49 REAL STEPFC
50 INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
51 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
52 * N1STTR,MDBASE
53 INTEGER CETAPE
54 CHARACTER*79 DSN
55 CHARACTER*20 HOST,USER
56
57 LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
58 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
59 * ,GHEISH,GHESIG
60*KEEP,STRBAR.
61 COMMON /STRBAR/ CSTRBA
62 DOUBLE PRECISION CSTRBA(11)
63*KEND.
64
65 INTEGER I,J
66C-----------------------------------------------------------------------
67
68 IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
69 444 FORMAT(' STRDEC: CURPAR=',1P,9E10.3)
70
71C COPY COORDINATES INTO SECPAR
72 DO 1 J = 5,8
73 SECPAR(J) = CURPAR(J)
74 1 CONTINUE
75
76 IF ( ITYPE .EQ. 18 ) THEN
77 CALL RMMAR( RD,1,1 )
78 IF ( RD(1) .LT. CSTRBA(5) ) THEN
79C DECAY LAMBDA ---> P + PI(-)
80 CALL DECAY1( ITYPE, 14, 9 )
81 ELSE
82C DECAY LAMBDA ---> N + PI(0)
83 CALL DECAY1( ITYPE, 13, 7 )
84 ENDIF
85
86 ELSEIF ( ITYPE .EQ. 19 ) THEN
87 CALL RMMAR( RD,1,1 )
88 IF ( RD(1) .LT. CSTRBA(6) ) THEN
89C DECAY SIGMA(+) ---> P + PI(0)
90 CALL DECAY1( ITYPE, 14, 7 )
91 ELSE
92C DECAY SIGMA(+) ---> N + PI(+)
93 CALL DECAY1( ITYPE, 13, 8 )
94 ENDIF
95
96 ELSEIF ( ITYPE .EQ. 20 .OR. ITYPE .EQ. 28 ) THEN
97C DECAY SIGMA(0) ---> LAMBDA + GAMMA
98C DECAY ANTI-SIGMA(0) ---> ANTI-LAMBDA + GAMMA
99 CALL DECAY1( ITYPE, ITYPE-2, 1 )
100
101 ELSEIF ( ITYPE .EQ. 21 ) THEN
102C DECAY SIGMA(-) ---> N + PI(-)
103 CALL DECAY1( ITYPE, 13, 9 )
104
105 ELSEIF ( ITYPE .EQ. 22 .OR. ITYPE .EQ. 30 ) THEN
106C DECAY XI(0) ---> LAMBDA + PI(0)
107C DECAY ANTI-XI(0) ---> ANTI-LAMBDA + PI(0)
108 CALL DECAY1( ITYPE, ITYPE-4, 7 )
109
110 ELSEIF ( ITYPE .EQ. 23 ) THEN
111C DECAY XI(-) ---> LAMBDA + PI(-)
112 CALL DECAY1( ITYPE, 18, 9 )
113
114 ELSEIF ( ITYPE .EQ. 24 .OR. ITYPE .EQ. 32 ) THEN
115 CALL RMMAR( RD,1,1 )
116 IF ( RD(1) .LT. CSTRBA(10) ) THEN
117C DECAY OMEGA(-) ---> LAMBDA + K(-)
118C DECAY ANTI-OMEGA(+) ---> ANTI-LAMBDA + K(+)
119 CALL DECAY1( ITYPE, ITYPE-6, 15-ITYPE/8 )
120 ELSEIF ( RD(1) .LT. CSTRBA(11) ) THEN
121C DECAY OMEGA(-) ---> XI(0) + PI(-)
122C DECAY ANTI-OMEGA(+) ---> ANTI-XI(0) + PI(+)
123 CALL DECAY1( ITYPE, ITYPE-2, 12-ITYPE/8 )
124 ELSE
125C DECAY OMEGA(-) ---> XI(-) + PI(0)
126C DECAY ANTI-OMEGA(+) ---> ANTI-XI(+) + PI(0)
127 CALL DECAY1( ITYPE, ITYPE-1, 7 )
128 ENDIF
129
130 ELSEIF ( ITYPE .EQ. 26 ) THEN
131 CALL RMMAR( RD,1,1 )
132 IF ( RD(1) .LT. CSTRBA(5) ) THEN
133C DECAY ANTI-LAMBDA ---> ANTI-P + PI(+)
134 CALL DECAY1( ITYPE, 15, 8 )
135 ELSE
136C DECAY ANTI-LAMBDA ---> ANTI-N + PI(0)
137 CALL DECAY1( ITYPE, 25, 7 )
138 ENDIF
139
140 ELSEIF ( ITYPE .EQ. 27 ) THEN
141 CALL RMMAR( RD,1,1 )
142 IF ( RD(1) .LT. CSTRBA(6) ) THEN
143C DECAY ANTI-SIGMA(-) ---> ANTI-P + PI(0)
144 CALL DECAY1( ITYPE, 15, 7 )
145 ELSE
146C DECAY ANTI-SIGMA(-) ---> ANTI-N + PI(-)
147 CALL DECAY1( ITYPE, 25, 9 )
148 ENDIF
149
150 ELSEIF ( ITYPE .EQ. 29 ) THEN
151C DECAY ANTI-SIGMA(+) ---> ANTI-N + PI(+)
152 CALL DECAY1( ITYPE, 25, 8 )
153
154 ELSEIF ( ITYPE .EQ. 31 ) THEN
155C DECAY ANTI-XI(+) ---> ANTI-LAMBDA + PI(+)
156 CALL DECAY1( ITYPE, 26, 8 )
157
158 ELSE
159 WRITE(MONIOU,*) 'STRDEC: UNFORESEEN PARTICLE CODE =',ITYPE
160 ENDIF
161 IRET1 = 1
162 RETURN
163 END
Note: See TracBrowser for help on using the repository browser.