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