source: trunk/MagicSoft/Simulation/Corsika/Mmcs/tstack.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: 4.0 KB
Line 
1 SUBROUTINE TSTACK
2
3C-----------------------------------------------------------------------
4C T(O) STACK
5C
6C ADDS PARTICLE TO INTERMEDIATE STACK UNTIL REACTION IS FINISHED
7C THIS SUBROUTINE IS CALLED FROM MANY POINTS ALL OVER THE PROGRAM
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,ELABCT.
23 COMMON /ELABCT/ ELCUT
24 DOUBLE PRECISION ELCUT(4)
25*KEEP,ETHMAP.
26 COMMON /ETHMAP/ ECTMAP,ELEFT
27 DOUBLE PRECISION ECTMAP,ELEFT
28*KEEP,MUPART.
29 COMMON /MUPART/ AMUPAR,BCUT,CMUON,FMUBRM,FMUORG
30 DOUBLE PRECISION AMUPAR(14),BCUT,CMUON(11)
31 LOGICAL FMUBRM,FMUORG
32*KEEP,PAM.
33 COMMON /PAM/ PAMA,SIGNUM
34 DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
35*KEEP,PARPAR.
36 COMMON /PARPAR/ CURPAR,SECPAR,PRMPAR,OUTPAR,C,
37 * E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
38 DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
39 * C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
40 INTEGER ITYPE,LEVL
41*KEEP,PARPAE.
42 DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
43 EQUIVALENCE (CURPAR(2),GAMMA), (CURPAR(3),COSTHE),
44 * (CURPAR(4), PHI ), (CURPAR(5), H ),
45 * (CURPAR(6), T ), (CURPAR(7), X ),
46 * (CURPAR(8), Y ), (CURPAR(9), CHI ),
47 * (CURPAR(10),BETA), (CURPAR(11),GCM ),
48 * (CURPAR(12),ECM )
49*KEEP,RUNPAR.
50 COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
51 * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
52 * MONIOU,MDEBUG,NUCNUC,
53 * CETAPE,
54 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
55 * N1STTR,MDBASE,
56 * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
57 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
58 * ,GHEISH,GHESIG
59 COMMON /RUNPAC/ DSN,HOST,USER
60 DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
61 REAL STEPFC
62 INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
63 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
64 * N1STTR,MDBASE
65 INTEGER CETAPE
66 CHARACTER*79 DSN
67 CHARACTER*20 HOST,USER
68
69 LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
70 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
71 * ,GHEISH,GHESIG
72*KEEP,STACKF.
73 COMMON /STACKF/ STACK,STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
74 INTEGER MAXSTK
75 PARAMETER (MAXSTK = 12*340*2)
76 DOUBLE PRECISION STACK(MAXSTK)
77 INTEGER STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
78*KEEP,THNVAR.
79 COMMON /THNVAR/ STACKINT,INT_ICOUNT,THINNING
80 INTEGER MAXICOUNT
81 PARAMETER (MAXICOUNT=20000)
82 DOUBLE PRECISION STACKINT(MAXICOUNT,13)
83 INTEGER INT_ICOUNT
84 LOGICAL THINNING
85*KEND.
86
87 INTEGER I,J
88C-----------------------------------------------------------------------
89
90 INT_ICOUNT = INT_ICOUNT + 1
91 IF ( DEBUG ) WRITE(MDEBUG,1) INT_ICOUNT,(SECPAR(J),J=1,9)
92 1 FORMAT(' TSTACK:',I7,1X,1P,9E10.3)
93
94 IF ( INT_ICOUNT .GT. MAXICOUNT ) THEN
95 WRITE(MONIOU,10) MAXICOUNT
96 10 FORMAT(' TSTACK: TOO MANY SECONDARIES FOR THIS REACTION',
97 * ' EXCEEDED ',I7,' A T T E N T I O N PARTICLE IS LOST')
98 INT_ICOUNT = INT_ICOUNT - 1
99 RETURN
100 ENDIF
101
102 DO I=1,MAXLEN
103 STACKINT(INT_ICOUNT,I) = SECPAR(I)
104 ENDDO
105
106 RETURN
107 END
Note: See TracBrowser for help on using the repository browser.