source: branches/start/MagicSoft/Simulation/Corsika/Mmcs/thick.f@ 14476

Last change on this file since 14476 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: 4.3 KB
Line 
1C=======================================================================
2
3 DOUBLE PRECISION FUNCTION THICK( ARG )
4
5C-----------------------------------------------------------------------
6C THICK(NESS OF ATMOSPHERE)
7C
8C CALCULATES THICKNESS (G/CM**2) OF ATMOSPHERE DEPENDING ON HEIGHT (CM)
9C (US STANDARD ATMOSPHERE)
10C THIS FUNCTION IS CALLED FROM MAIN, BOX2, BOX3, CERENE, CERENH, EGS4,
11C ELECTR, ININKG, INPRM, NKG, PHOTON, AND START
12C ARGUMENT:
13C ARG = HEIGHT IN CM
14C-----------------------------------------------------------------------
15
16 IMPLICIT NONE
17*KEEP,ATMOS.
18 COMMON /ATMOS/ AATM,BATM,CATM,DATM
19 DOUBLE PRECISION AATM(5),BATM(5),CATM(5),DATM(5)
20*KEEP,RUNPAR.
21 COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
22 * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
23 * MONIOU,MDEBUG,NUCNUC,
24 * CETAPE,
25 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
26 * N1STTR,MDBASE,
27 * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
28 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
29 * ,GHEISH,GHESIG
30 COMMON /RUNPAC/ DSN,HOST,USER
31 DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
32 REAL STEPFC
33 INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
34 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
35 * N1STTR,MDBASE
36 INTEGER CETAPE
37 CHARACTER*79 DSN
38 CHARACTER*20 HOST,USER
39
40 LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
41 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
42 * ,GHEISH,GHESIG
43c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
44c Try
45c------------------------------------------------------------
46*KEEP,PARPAR.
47 COMMON /PARPAR/ CURPAR,SECPAR,PRMPAR,OUTPAR,C,
48 * E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
49 DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
50 * C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
51 INTEGER ITYPE,LEVL
52c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
53*KEND.
54C*******************************************************************
55C Modificado por Aitor (5-febrero-98)
56
57 common /aitor/ aitoth
58 double precision aitoth
59C*******************************************************************
60
61 DOUBLE PRECISION ARG,H,RT
62 PARAMETER (RT=6348.0D5)
63C-----------------------------------------------------------------------
64
65CC IF ( DEBUG ) WRITE(MDEBUG,*) 'THICK : ARG=',SNGL(ARG)
66
67c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
68c>> Modification (HZA trick) cancelled >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
69c>> JCG Wed Sep 21 10:49:14 MET DST 1998 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
70c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
71 IF ( ARG .LT. 4.D5 ) THEN
72 THICK = AATM(1) + BATM(1) * EXP ( -ARG * DATM(1) )
73 ELSEIF ( ARG .LT. 1.D6 ) THEN
74 THICK = AATM(2) + BATM(2) * EXP ( -ARG * DATM(2) )
75 ELSEIF ( ARG .LT. 4.D6 ) THEN
76 THICK = AATM(3) + BATM(3) * EXP ( -ARG * DATM(3) )
77 ELSEIF ( ARG .LT. 1.D7 ) THEN
78 THICK = AATM(4) + BATM(4) * EXP ( -ARG * DATM(4) )
79 ELSE
80 THICK = AATM(5) - ARG * CATM(5)
81 ENDIF
82c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
83cC*******************************************************************
84cC Modificado por Aitor (5-febrero-98)
85c
86c H = -RT + SQRT(RT**2 + (ARG/COS(aitoth))**2 +(2.0D0*RT*ARG))
87cC*******************************************************************
88c
89cC R = SQRT(CURPAR(7)**2+CURPAR(8)**2)
90cC H = SQRT((RT+ARG)**2+R**2)-RT
91cc print *,'THICK>>',arg,r,h,curpar(7),curpar(8)
92c
93c IF ( H .LT. 4.D5 ) THEN
94c THICK = AATM(1) + BATM(1) * EXP ( -H * DATM(1) )
95c ELSEIF ( H .LT. 1.D6 ) THEN
96c THICK = AATM(2) + BATM(2) * EXP ( -H * DATM(2) )
97c ELSEIF ( H .LT. 4.D6 ) THEN
98c THICK = AATM(3) + BATM(3) * EXP ( -H * DATM(3) )
99c ELSEIF ( H .LT. 1.D7 ) THEN
100c THICK = AATM(4) + BATM(4) * EXP ( -H * DATM(4) )
101c ELSE
102c THICK = AATM(5) - H * CATM(5)
103c ENDIF
104c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
105
106 RETURN
107 END
Note: See TracBrowser for help on using the repository browser.