This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / gtrak / gsstak.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:21:43  cernlib
6 * Geant
7 *
8 *
9 #include "geant321/pilot.h"
10 *CMZ :  3.21/02 29/03/94  15.41.23  by  S.Giani
11 *-- Author :
12       SUBROUTINE GSSTAK (IFLAG)
13 C.
14 C.    ******************************************************************
15 C.    *                                                                *
16 C.    *    SUBR. GSSTAK (IFLAG)                                        *
17 C.    *                                                                *
18 C.    *   Stores in auxiliary stack JSTAK the particle currently       *
19 C.    *    described in common /GCKINE/.                               *
20 C.    *                                                                *
21 C.    *   On request, creates also an entry in structure JKINE :       *
22 C.    *    IFLAG =                                                     *
23 C.    *     0 : No entry in JKINE structure required (user)            *
24 C.    *     1 : New entry in JVERTX / JKINE structures required (user) *
25 C.    *    <0 : New entry in JKINE structure at vertex -IFLAG (user)   *
26 C.    *     2 : Entry in JKINE structure exists already (from GTREVE)  *
27 C.    *                                                                *
28 C.    *   Called by : GSKING, GTREVE                                   *
29 C.    *   Author    : S.Banerjee, F.Bruyant                            *
30 C.    *                                                                *
31 C.    ******************************************************************
32 C.
33 #include "geant321/gcbank.inc"
34 #include "geant321/gckine.inc"
35 #include "geant321/gcjloc.inc"
36 #include "geant321/gcmzfo.inc"
37 #include "geant321/gcnum.inc"
38 #include "geant321/gcstak.inc"
39 #include "geant321/gctrak.inc"
40 #if defined(CERNLIB_USRJMP)
41 #include "geant321/gcjump.inc"
42 #endif
43 *
44       COMMON/VTXKIN/NVTX,ITR
45       DIMENSION UBUF(1)
46       DATA UBUF/0./
47 C.
48 C.    ------------------------------------------------------------------
49 *
50       IF (IPART.LE.0.OR.IPART.GT.NPART) THEN
51          PRINT *, ' GSSTAK - Unknown particle code, skip track ', IPART
52          GO TO 999
53       ENDIF
54 *
55 * *** Give control to user for track selection
56 *
57 #if !defined(CERNLIB_USRJMP)
58       CALL GUSKIP(ISKIP)
59 #endif
60 #if defined(CERNLIB_USRJMP)
61       CALL JUMPT1(JUSKIP,ISKIP)
62 #endif
63       IF (ISKIP.NE.0) GO TO 999
64 *
65 * *** Check if an entry in JKINE structure is required
66 *
67       IF (IFLAG.EQ.1) THEN
68          CALL GSVERT (VERT, ITRA, 0, UBUF, 0, NVTX)
69          CALL GSKINE (PVERT, IPART, NVTX, UBUF, 0, ITR)
70       ELSE IF (IFLAG.LT.0) THEN
71          NVTX = -IFLAG
72          CALL GSKINE (PVERT, IPART, NVTX, UBUF, 0, ITR)
73       ELSE
74          IF (IFLAG.EQ.0) THEN
75 *          Store -ITRA in stack for a track without entry in JKINE
76             ITR = -ITRA
77          ELSE
78             ITR = ITRA
79          ENDIF
80       ENDIF
81 *
82 * *** Store information in stack
83 *
84       IF (JSTAK.EQ.0) THEN
85          NDBOOK = NTSTKP*NWSTAK +3
86          NDPUSH = NTSTKS*NWSTAK
87          CALL MZBOOK (IXCONS,JSTAK,JSTAK,1,'STAK', 0,0,NDBOOK, IOSTAK,3)
88          IQ(JSTAK+2) = NTSTKP
89       ELSE IF (IQ(JSTAK+1).EQ.IQ(JSTAK+2)) THEN
90          CALL MZPUSH (IXCONS, JSTAK, 0, NDPUSH, 'I')
91          IQ(JSTAK+2) = IQ(JSTAK+2) +NTSTKS
92       ENDIF
93 *
94       JST = JSTAK +IQ(JSTAK+1)*NWSTAK +3
95       IQ(JSTAK+1) = IQ(JSTAK+1) +1
96       IF (IQ(JSTAK+3).EQ.0) IQ(JSTAK+3) = IQ(JSTAK+1)
97       IF (IQ(JSTAK+1).GT.NSTMAX)  NSTMAX = IQ(JSTAK+1)
98 *
99       IQ(JST+1)   = ITR
100       IQ(JST+2)   = IPART
101       IQ(JST+3)   = 0
102       DO 90 I = 1,3
103          Q(JST+3+I) = VERT(I)
104          Q(JST+6+I) = PVERT(I)
105    90 CONTINUE
106       Q(JST+10) = TOFG
107       Q(JST+11) = SAFETY
108       Q(JST+12) = UPWGHT
109 *
110       NALIVE = NALIVE +1
111 *                                                             END GSSTAK
112   999 END