source: trunk/MagicSoft/Simulation/Corsika/Mmcs/em.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: 3.4 KB
Line 
1 SUBROUTINE EM
2
3C-----------------------------------------------------------------------
4C E(LECTRO) M(AGNETIC PARTICLES)
5C
6C ROUTINE FOR TREATING EM PARTICLES
7C THIS SUBROUTINE IS CALLED FROM BOX3
8C-----------------------------------------------------------------------
9
10 IMPLICIT NONE
11*KEEP,GENER.
12 COMMON /GENER/ GEN,ALEVEL
13 DOUBLE PRECISION GEN,ALEVEL
14*KEEP,PAM.
15 COMMON /PAM/ PAMA,SIGNUM
16 DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
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,RUNPAR.
32 COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
33 * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
34 * MONIOU,MDEBUG,NUCNUC,
35 * CETAPE,
36 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
37 * N1STTR,MDBASE,
38 * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
39 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
40 * ,GHEISH,GHESIG
41 COMMON /RUNPAC/ DSN,HOST,USER
42 DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
43 REAL STEPFC
44 INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
45 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
46 * N1STTR,MDBASE
47 INTEGER CETAPE
48 CHARACTER*79 DSN
49 CHARACTER*20 HOST,USER
50
51 LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
52 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
53 * ,GHEISH,GHESIG
54*KEND.
55
56 DOUBLE PRECISION ENER
57 INTEGER I
58C-----------------------------------------------------------------------
59
60 IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
61 444 FORMAT(' EM : CURPAR=',1P,9E10.3)
62
63C GET CORRECT PARTICLE ENERGY
64 IF ( ITYPE .EQ. 1 ) THEN
65 ENER = CURPAR(2)
66 ELSEIF ( ITYPE .EQ. 2 .OR. ITYPE .EQ. 3 ) THEN
67 ENER = SECPAR(2) * PAMA(2)
68 ELSE
69 WRITE(MONIOU,*) 'EM : WRONG PARTICLE CODE =',ITYPE
70 RETURN
71 ENDIF
72
73C LOOK FOR ENERGY OF EM PARTICLE
74* IF ( ENER .LE. 1.D7 ) THEN
75C EM-PARTICLE ENERGY IS BELOW LPM EFFECT, STORE IT TO SECPAR
76C LPM LIMIT IS SET AT 1.*10**16 EV = 1.*10**7 GEV
77 DO 101 I = 1,8
78 SECPAR(I) = CURPAR(I)
79 101 CONTINUE
80 SECPAR( 9) = GEN
81 SECPAR(10) = ALEVEL
82
83C CALL NKG IF SELECTED
84 IF ( FNKG ) THEN
85 CALL NKG( ENER )
86 ENDIF
87
88C CALL EGS4 IF SELECTED ( PARTICLE IS TAKEN IN EGS FROM COMMON )
89 IF ( FEGS ) THEN
90 CALL EGS4( ENER )
91 ENDIF
92
93* ELSE
94C EM-PARTICLE ENERGY IS ABOVE LPM EFFECT AND MUST BE TREATED BY LPM,
95C IF EM_PARTICLES ARE REQUESTED BY EGS OR NKG
96* IF ( FNKG .OR. FEGS ) CALL LPM(ENER)
97* ENDIF
98
99 RETURN
100 END
Note: See TracBrowser for help on using the repository browser.