source: trunk/MagicSoft/Simulation/Corsika/Mmcs/ininkg.f@ 18066

Last change on this file since 18066 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.3 KB
Line 
1 SUBROUTINE ININKG
2
3C-----------------------------------------------------------------------
4C INI(TIALIZE) NKG
5C
6C INITIALIZES ARRAYS FOR NKG CALCULATING VARIABLES
7C THIS SUBROUTINE IS CALLED FROM MAIN
8C-----------------------------------------------------------------------
9
10 IMPLICIT NONE
11*KEEP,BUFFS.
12 COMMON /BUFFS/ RUNH,RUNE,EVTH,EVTE,DATAB,LH
13 INTEGER MAXBUF,MAXLEN
14 PARAMETER (MAXBUF=39*7)
15 PARAMETER (MAXLEN=12)
16 REAL RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
17 * RUNE(MAXBUF),DATAB(MAXBUF)
18 INTEGER LH
19 CHARACTER*4 CRUNH,CRUNE,CEVTH,CEVTE
20 EQUIVALENCE (RUNH(1),CRUNH), (RUNE(1),CRUNE)
21 EQUIVALENCE (EVTH(1),CEVTH), (EVTE(1),CEVTE)
22*KEEP,NKGI.
23 COMMON /NKGI/ SEL,SELLG,STH,ZEL,ZELLG,ZSL,DIST,
24 * DISX,DISY,DISXY,DISYX,DLAX,DLAY,DLAXY,DLAYX,
25 * OBSATI,RADNKG,RMOL,TLEV,TLEVCM,IALT
26 DOUBLE PRECISION SEL(10),SELLG(10),STH(10),ZEL(10),ZELLG(10),
27 * ZSL(10),DIST(10),
28 * DISX(-10:10),DISY(-10:10),
29 * DISXY(-10:10,2),DISYX(-10:10,2),
30 * DLAX (-10:10,2),DLAY (-10:10,2),
31 * DLAXY(-10:10,2),DLAYX(-10:10,2),
32 * OBSATI(2),RADNKG,RMOL(2),TLEV(10),TLEVCM(10)
33 INTEGER IALT(2)
34*KEEP,OBSPAR.
35 COMMON /OBSPAR/ OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
36 * THETPR,PHIPR,NOBSLV
37 DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
38 * THETAP,THETPR(2),PHIP,PHIPR(2)
39 INTEGER NOBSLV
40*KEEP,RUNPAR.
41 COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
42 * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
43 * MONIOU,MDEBUG,NUCNUC,
44 * CETAPE,
45 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
46 * N1STTR,MDBASE,
47 * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
48 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
49 * ,GHEISH,GHESIG
50 COMMON /RUNPAC/ DSN,HOST,USER
51 DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
52 REAL STEPFC
53 INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
54 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
55 * N1STTR,MDBASE
56 INTEGER CETAPE
57 CHARACTER*79 DSN
58 CHARACTER*20 HOST,USER
59
60 LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
61 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
62 * ,GHEISH,GHESIG
63*KEND.
64
65 DOUBLE PRECISION DEPTH,HEIGH,RHOF,RMGCM,THICK
66 INTEGER I,IL,K,KL
67 EXTERNAL HEIGH,RHOF,THICK
68 DATA RMGCM / 9.6D0 /
69C-----------------------------------------------------------------------
70
71 IF ( DEBUG ) WRITE(MDEBUG,*) 'ININKG:'
72
73C SET LATERAL DISTRIBUTION DISTANCES
74 IF ( RADNKG .LE. 100.D0 ) THEN
75 WRITE(MONIOU,*) 'ININKG: RADNKG=',RADNKG,' CM TOO SMALL '
76 RADNKG = 200.D2
77 WRITE(MONIOU,*) ' RADNKG CORRECTED TO ',RADNKG,' CM'
78 ENDIF
79 EVTH(148) = RADNKG
80 DO I=1,10
81 DIST(I) = 100.D0 * 10.D0**(LOG10(RADNKG/100.D0)*0.1D0*I)
82 DISX(I) = DIST(I)
83 DISX(-I) = -DIST(I)
84 ENDDO
85 DISX(0) = 0.D0
86
87C MOLIERE RADIUS FOR COULOMB SCATTERING ; EQUIVALENT TO 9.6 G/CM**2
88C OBSERVATION LEVELS AND CORRESPONDING MOLIERE RADII (IN CM) FOR NKG
89 OBSATI(1) = OBSLEV(NOBSLV)
90 RMOL (1) = RMGCM / RHOF(OBSATI(1))
91 IF ( NOBSLV .GT. 1 ) THEN
92 OBSATI(2) = OBSLEV(NOBSLV-1)
93 RMOL (2) = RMGCM / RHOF(OBSATI(2))
94 ELSE
95 OBSATI(2) = -1.D0
96 RMOL (2) = 0.D0
97 IALT (2) = 0
98 ENDIF
99
100C CALCULATE COORDINATES OF POINTS ON THE X AND Y AXIS AND THE TWO
101C DIAGONAL LINES Y IS X AND Y IS -X
102 DO 3333 KL = -10,10
103 DISY (KL) = DISX (KL)
104 DISXY(KL,1) = DISX (KL) / SQRT(2.D0)
105 DISXY(KL,2) = DISXY(KL,1)
106 DISYX(KL,1) = DISXY(KL,1)
107 DISYX(KL,2) = -DISXY(KL,2)
108 3333 CONTINUE
109C CLEAR ARRAY FOR LATERAL ELECTRON DISTR. (AVERAGE OVER ALL SHOWERS)
110 DO 45 K = 1,2
111 DO 45 I = -10,10
112 DLAX (I,K) = 0.D0
113 DLAY (I,K) = 0.D0
114 DLAXY(I,K) = 0.D0
115 DLAYX(I,K) = 0.D0
116 45 CONTINUE
117C CLEAR ARRAY FOR AGE PARAMETER CALCULATION (AVERAGE OVER ALL SHOWERS)
118 DO 17 I = 1,10
119 SEL(I) = 0.D0
120 SELLG(I) = 0.D0
121 STH(I) = 0.D0
122 ZELLG(I) = 0.D0
123 ZEL(I) = 0.D0
124 ZSL(I) = 0.D0
125 17 CONTINUE
126
127C LAST OBSERVATION LEVEL DEPTH IS GIVEN IN G/CM**2
128 DEPTH = THICK(OBSATI(1))
129 IALT(1) = MIN( 10, INT(DEPTH/102.D0)+1 )
130C CALCULATE 10 LEVELS AT EACH 100 G/CM**2
131 DO 111 IL = 1,IALT(1)-1
132 TLEV (IL) = 100.D0 * IL
133 TLEVCM(IL) = HEIGH(TLEV(IL))
134 111 CONTINUE
135C FOR LAST LEVEL NOT IL*100 BUT OBSERVATION LEVEL
136 TLEV (IALT(1)) = DEPTH
137 TLEVCM(IALT(1)) = OBSATI(1)
138C SECOND OBSERVATION LEVEL ?
139 IF ( OBSATI(2) .GE. 0.D0 ) THEN
140 DEPTH = THICK(OBSATI(2))
141 IALT(2) = INT(DEPTH/102.D0) + 1
142 IF ( IALT(2) .GE. IALT(1) ) IALT(2) = IALT(1) - 1
143 TLEV (IALT(2)) = DEPTH
144 TLEVCM(IALT(2)) = OBSATI(2)
145 ENDIF
146
147 RETURN
148 END
Note: See TracBrowser for help on using the repository browser.