source: trunk/MagicSoft/Simulation/Corsika/Mmcs/tstend.f@ 5059

Last change on this file since 5059 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 TSTEND
2
3C-----------------------------------------------------------------------
4C T(O) STACK END (OF REACTION)
5C
6C MOVE INTERMEDIATE REACTION STACK TO THE REAL STACK
7C THIS SUBROUTINE IS CALLED FROM AAMAIN, BOX3, AND PIGEN
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,PAM.
23 COMMON /PAM/ PAMA,SIGNUM
24 DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
25*KEEP,PARPAR.
26 COMMON /PARPAR/ CURPAR,SECPAR,PRMPAR,OUTPAR,C,
27 * E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
28 DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
29 * C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
30 INTEGER ITYPE,LEVL
31*KEEP,PARPAE.
32 DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
33 EQUIVALENCE (CURPAR(2),GAMMA), (CURPAR(3),COSTHE),
34 * (CURPAR(4), PHI ), (CURPAR(5), H ),
35 * (CURPAR(6), T ), (CURPAR(7), X ),
36 * (CURPAR(8), Y ), (CURPAR(9), CHI ),
37 * (CURPAR(10),BETA), (CURPAR(11),GCM ),
38 * (CURPAR(12),ECM )
39*KEEP,RANDPA.
40 COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR
41 DOUBLE PRECISION FAC,U1,U2
42 REAL RD(3000)
43 INTEGER ISEED(103,10),NSEQ
44 LOGICAL KNOR
45*KEEP,RESON.
46 COMMON /RESON/ RDRES,RESRAN,IRESPAR
47 REAL RDRES(2),RESRAN(1000)
48 INTEGER IRESPAR
49
50*KEEP,RUNPAR.
51 COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
52 * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
53 * MONIOU,MDEBUG,NUCNUC,
54 * CETAPE,
55 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
56 * N1STTR,MDBASE,
57 * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
58 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
59 * ,GHEISH,GHESIG
60 COMMON /RUNPAC/ DSN,HOST,USER
61 DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
62 REAL STEPFC
63 INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
64 * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
65 * N1STTR,MDBASE
66 INTEGER CETAPE
67 CHARACTER*79 DSN
68 CHARACTER*20 HOST,USER
69
70 LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
71 * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
72 * ,GHEISH,GHESIG
73*KEEP,STACKF.
74 COMMON /STACKF/ STACK,STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
75 INTEGER MAXSTK
76 PARAMETER (MAXSTK = 12*340*2)
77 DOUBLE PRECISION STACK(MAXSTK)
78 INTEGER STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
79*KEEP,THNVAR.
80 COMMON /THNVAR/ STACKINT,INT_ICOUNT,THINNING
81 INTEGER MAXICOUNT
82 PARAMETER (MAXICOUNT=20000)
83 DOUBLE PRECISION STACKINT(MAXICOUNT,13)
84 INTEGER INT_ICOUNT
85 LOGICAL THINNING
86*KEND.
87
88 DOUBLE PRECISION EEE,EEPP,ETOTA,ETOTAL
89 INTEGER I,K
90C-----------------------------------------------------------------------
91
92 IF ( DEBUG ) WRITE(MDEBUG,1) INT_ICOUNT,THINNING
93 1 FORMAT(' TSTEND: TRANSFER INTERNAL REACTION STACK',
94 * ' WITH ',I6,' PARTICLES: ', ' THINNING =',L4)
95
96 IF ( INT_ICOUNT .LE. 0 ) RETURN
97
98C PUT ALL PARTICLES FROM INTERMEDIATE STACK TO REAL STACK
99 DO K=1,INT_ICOUNT
100 DO I=1,MAXLEN
101 SECPAR(I) = STACKINT(K,I)
102 STACKINT(K,I) = 0.D0
103 ENDDO
104 CALL TSTOUT
105 ENDDO
106
107 RETURN
108 END
Note: See TracBrowser for help on using the repository browser.