source: trunk/MagicSoft/Simulation/Corsika/Mmcs/outend.f

Last change on this file 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: 8.7 KB
Line 
1 SUBROUTINE OUTEND
2
3C-----------------------------------------------------------------------
4C OUT(PUT AT) END (OF SHOWER)
5C
6C WRITE REST OF PARTICLES TO OUTPUT BUFFER
7C PRINTS INTERACTION LENGTHS STATISTICS
8C THIS SUBROUTINE IS CALLED FROM MAIN
9C-----------------------------------------------------------------------
10
11 IMPLICIT NONE
12*KEEP,BAL.
13 COMMON /BAL/ EBAL
14 DOUBLE PRECISION EBAL(10)
15*KEEP,BUFFS.
16 COMMON /BUFFS/ RUNH,RUNE,EVTH,EVTE,DATAB,LH
17 INTEGER MAXBUF,MAXLEN
18 PARAMETER (MAXBUF=39*7)
19 PARAMETER (MAXLEN=12)
20 REAL RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
21 * RUNE(MAXBUF),DATAB(MAXBUF)
22 INTEGER LH
23 CHARACTER*4 CRUNH,CRUNE,CEVTH,CEVTE
24 EQUIVALENCE (RUNH(1),CRUNH), (RUNE(1),CRUNE)
25 EQUIVALENCE (EVTH(1),CEVTH), (EVTE(1),CEVTE)
26*KEEP,CHISTA.
27 COMMON /CHISTA/ IHYCHI,IKACHI,IMUCHI,INNCHI,INUCHI,IPICHI
28 INTEGER IHYCHI(124),IKACHI(124),IMUCHI(124),
29 * INNCHI(124),INUCHI(124),IPICHI(124)
30*KEEP,ELADPM.
31 COMMON /ELADPM/ ELMEAN,ELMEAA,IELDPM,IELDPA
32 DOUBLE PRECISION ELMEAN(37),ELMEAA(37)
33 INTEGER IELDPM(37,13),IELDPA(37,13)
34*KEEP,MULT.
35 COMMON /MULT/ EKINL,MSMM,MULTMA,MULTOT
36 DOUBLE PRECISION EKINL
37 INTEGER MSMM,MULTMA(37,13),MULTOT(37,13)
38*KEEP,NCOUNT.
39 COMMON /NCOUNT/ NCOUN
40 INTEGER NCOUN(8)
41*KEEP,NPARTI.
42 COMMON /NPARTI/ NPARTO,MUOND
43 DOUBLE PRECISION NPARTO(10,25),NPHOTO(10),NPOSIT(10),NELECT(10),
44 * NNU(10),NMUP(10),NMUM(10),NPI0(10),NPIP(10),
45 * NPIM(10),NK0L(10),NKPL(10),NKMI(10),NNEUTR(10),
46 * NPROTO(10),NPROTB(10),NK0S(10),NHYP(10),
47 * NNEUTB(10),NDEUT(10),NTRIT(10),NALPHA(10),
48 * NOTHER(10),MUOND
49 EQUIVALENCE (NPARTO(1, 1),NPHOTO(1)), (NPARTO(1, 2),NPOSIT(1)),
50 * (NPARTO(1, 3),NELECT(1)), (NPARTO(1, 4),NNU(1)) ,
51 * (NPARTO(1, 5),NMUP(1)) , (NPARTO(1, 6),NMUM(1)) ,
52 * (NPARTO(1, 7),NPI0(1)) , (NPARTO(1, 8),NPIP(1)) ,
53 * (NPARTO(1, 9),NPIM(1)) , (NPARTO(1,10),NK0L(1)) ,
54 * (NPARTO(1,11),NKPL(1)) , (NPARTO(1,12),NKMI(1)) ,
55 * (NPARTO(1,13),NNEUTR(1)), (NPARTO(1,14),NPROTO(1)),
56 * (NPARTO(1,15),NPROTB(1)), (NPARTO(1,16),NK0S(1)) ,
57 * (NPARTO(1,18),NHYP(1)) , (NPARTO(1,19),NDEUT(1)) ,
58 * (NPARTO(1,20),NTRIT(1)) , (NPARTO(1,21),NALPHA(1)),
59 * (NPARTO(1,22),NOTHER(1)), (NPARTO(1,25),NNEUTB(1))
60*KEEP,PARPAR.
61 COMMON /PARPAR/ CURPAR,SECPAR,PRMPAR,OUTPAR,C,
62 * E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
63 DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
64 * C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
65 INTEGER ITYPE,LEVL
66*KEEP,PARPAE.
67 DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
68 EQUIVALENCE (CURPAR(2),GAMMA), (CURPAR(3),COSTHE),
69 * (CURPAR(4), PHI ), (CURPAR(5), H ),
70 * (CURPAR(6), T ), (CURPAR(7), X ),
71 * (CURPAR(8), Y ), (CURPAR(9), CHI ),
72 * (CURPAR(10),BETA), (CURPAR(11),GCM ),
73 * (CURPAR(12),ECM )
74*KEEP,PBALA.
75 COMMON /PBALA/ PBAL
76 DOUBLE PRECISION PBAL(10)
77*KEEP,RECORD.
78 COMMON /RECORD/ IRECOR
79 INTEGER IRECOR
80*KEEP,RUNPAR.
81 COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
82 * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
83 * MONIOU,MDEBUG,NUCNUC,
84 * CETAPE,
85 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
86 * N1STTR,MDBASE,
87 * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
88 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
89 * ,GHEISH,GHESIG
90 COMMON /RUNPAC/ DSN,HOST,USER
91 DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
92 REAL STEPFC
93 INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
94 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
95 * N1STTR,MDBASE
96 INTEGER CETAPE
97 CHARACTER*79 DSN
98 CHARACTER*20 HOST,USER
99
100 LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
101 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
102 * ,GHEISH,GHESIG
103*KEEP,STACKF.
104 COMMON /STACKF/ STACK,STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
105 INTEGER MAXSTK
106 PARAMETER (MAXSTK = 12*340*2)
107 DOUBLE PRECISION STACK(MAXSTK)
108 INTEGER STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
109*KEEP,STATI.
110 COMMON /STATI/ SABIN,SBBIN,INBIN,IPBIN,IKBIN,IHBIN
111 DOUBLE PRECISION SABIN(37),SBBIN(37)
112 INTEGER INBIN(37),IPBIN(37),IKBIN(37),IHBIN(37)
113*KEND.
114
115 INTEGER I,J,K,NELMEA
116C-----------------------------------------------------------------------
117
118 IF ( LH .GT. 0 ) THEN
119 CALL TOBUF( DATAB,0 )
120 DO 2 I = 1,MAXBUF
121 DATAB(I) = 0.
122 2 CONTINUE
123 ENDIF
124 LH = 0
125
126 IF ( FPRINT .OR. DEBUG ) THEN
127 WRITE(MONIOU,101) NSHIFT,NOPART
128 101 FORMAT(' ',I10,' SHIFTS TO EXTERNAL STACK'/
129 * ' ',I10,' PARTICLES WRITTEN TO PATAPE')
130
131 IF ( .NOT. GHEISH ) THEN
132 WRITE(MONIOU,103) (EBAL(I),I=1,10)
133 103 FORMAT (/' ENERGY BALANCE OF PARTICLE PRODUCTION PROCESSES'//
134 * 1P,5E20.8/5E20.8/)
135
136 WRITE(MONIOU,203) (PBAL(I),I=1,10)
137 203 FORMAT (' MOMENTUM BALANCE OF PARTICLE PRODUCTION PROCESSES'//
138 * 1P,5E20.8/5E20.8/)
139
140 WRITE(MONIOU,104) (NCOUN(K),K=1,8)
141 104 FORMAT(//
142 * I10,' / ',I6,' ANTINUCLEONS ENTER / ANNIHILATE IN BOX 60'/
143 * I10,' / ',I6,' ANTINUCLEONS ENTER / ANNIHILATE IN BOX 61'/
144 * I10,' / ',I6,' ANTINUCLEONS ENTER / ANNIHILATE IN BOX 62'/
145 * I10,' / ',I6,' ANTINUCLEONS ENTER / ANNIHILATE IN BOX 63'/)
146 ENDIF
147 ENDIF
148
149 IF ( FPRINT ) THEN
150C PRINT ENERGY - MULTIPLICITY MATRIX
151 WRITE(MONIOU,209) SHOWNO,(K,K=1,13),
152 * (J,(MULTMA(J,K),K=1,13),10**((J-4.)/3.),10**((J-3.)/3.),J=1,37),
153 * 1,(INT(10**((K-1.)/3.)+1 ),K = 2,13),
154 * 2,(INT(10**((K )/3.) ),K = 2,13)
155 209 FORMAT(//' ENERGY - MULTIPLICITY MATRIX OF SHOWER NO ',I10/
156 * ' ENERGY RUNS VERTICALLY, MULTIPLICITY HORIZONTALLY'//
157 * ' ',5X,5I9,3I8,5I7,' ENERGY RANGE (GEV)'/
158 * 37(/' ',I4,1X,5I9,3I8,5I7,2X,1P,2E10.1,0P)//
159 * ' MULT.',5I9,3I8,5I7,5X,'LOWER BIN LIMIT'/
160 * ' RANGE',5I9,3I8,5I7,5X,'UPPER BIN LIMIT')
161 ENDIF
162
163C GET MEAN OF ELASTICITY FOR ENERGY BINS
164 DO 3377 J = 1,37
165 NELMEA = 0
166 DO 3378 K = 1,10
167 NELMEA = NELMEA + IELDPM(J,K)
168 3378 CONTINUE
169 IF ( NELMEA .NE. 0 ) ELMEAN(J) = ELMEAN(J) / NELMEA
170 3377 CONTINUE
171
172 IF ( FPRINT ) THEN
173C PRINT ENERGY - ELASTICITY MATRIX
174 WRITE(MONIOU,408) SHOWNO,(K,K=1,10),
175 * (J,(IELDPM(J,K),K=1,10),
176 * ELMEAN(J),10**((J-4.)/3.),10**((J-3.)/3.),J=1,37),
177 * ((K-1)*0.1,K=1,10),(K*0.1,K=1,10)
178 408 FORMAT (//' ENERGY - ELASTICITY MATRIX OF SHOWER NO ',I10/
179 * ' ENERGY RUNS VERTICALLY, ELASTICITY HORIZONTALLY'//
180 * ' ',5X,10I9,' MEAN EL. ENERGY RANGE (GEV)'/
181 * 37(/' ',I4,1X,10I9,2X,1P,E10.3,2E10.1,0P)//
182 * ' ELA. ',10F9.2,5X,'LOWER BIN LIMIT'/
183 * ' RANGE',10F9.2,5X,'UPPER BIN LIMIT')
184
185 WRITE(MONIOU,204) SHOWNO
186 204 FORMAT(//' INTERACTIONS PER KINETIC ENERGY INTERVAL OF SHOWER',
187 * ' NO ',I10//)
188
189 WRITE(MONIOU,205)
190 205 FORMAT(' BIN LOWER LIMIT UPPER LIMIT ',
191 * ' NUCLEON PIONS KAONS S.BARYONS TOTAL'/
192 * ' IN GEV IN GEV ',
193 * ' EVENTS EVENTS EVENTS EVENTS '/)
194 WRITE(MONIOU,207) (I,SABIN(I),SBBIN(I),INBIN(I),IPBIN(I),
195 * IKBIN(I),IHBIN(I),INBIN(I)+IPBIN(I)+IKBIN(I)+IHBIN(I),I=1,37)
196 207 FORMAT(' ',I5,1P,2E15.4,0P,1X,5I11)
197
198 WRITE(MONIOU,301)
199 301 FORMAT (//' INTERACTION LENGTH STATISTICS: ',
200 * ' 1 BIN CORRESPONDS TO 10 G/CM**2 OR 1KM FOR MUONS'//
201 * ' BIN LAMBDA NU LAMBDA PI LAMBDA KA ',
202 * 'LAMBDA HY LAMBDA MU LAMBDA NUCLEUS'/)
203 WRITE(MONIOU,303) (I,INUCHI(I),IPICHI(I),IKACHI(I),IHYCHI(I),
204 * IMUCHI(I),INNCHI(I),I=1,124)
205 303 FORMAT (' ',I4,6I12)
206
207 WRITE(MONIOU,105) IRECOR
208 105 FORMAT (/' NO OF WORDS WRITTEN TO PARTICLE TAPE UP TO NOW =',
209 * I10)
210 ENDIF
211
212 RETURN
213 END
Note: See TracBrowser for help on using the repository browser.