GEANT321/gtrak/gsking.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 GSKING (IGK)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *    SUBR. GSKING (IGK)                                          *
  17 C.    *                                                                *
  18 C.    *   Stores in stack JSTAK either the IGKth track of /GCKING/,    *
  19 C.    *    or the NGKINE tracks when IGK is 0.                         *
  20 C.    *                                                                *
  21 C.    *   Called by : 'User'                                           *
  22 C.    *   Authors   : R.Brun, F.Bruyant                                *
  23 C.    *                                                                *
  24 C.    ******************************************************************
  25 C.
  26 #include "geant321/gcunit.inc"
  27 #include "geant321/gcbank.inc"
  28 #include "geant321/gckine.inc"
  29 #include "geant321/gcking.inc"
  30 #include "geant321/gcnum.inc"
  31 #include "geant321/gctrak.inc"
  32 C.
  33       COMMON/VTXKIN/NVTX,ITR
  34       REAL PSTO(3), VSTO(3)
  35 C.
  36 C.    ------------------------------------------------------------------
  37 *
  38       IF (NGKINE.LE.0) GO TO 999
  39       IF (IGK.EQ.0) THEN
  40          N1 = 1
  41          N2 = NGKINE
  42       ELSE
  43          IF (IGK.LT.0.OR.IGK.GT.NGKINE) THEN
  44             WRITE(CHMAIL,10000) IGK, NGKINE
  45 10000 FORMAT(' GSKING - Abnormal request ',I4,1X,I4)
  46             CALL GMAIL(0,0)
  47             GO TO 999
  48          ENDIF
  49          N1 = IGK
  50          N2 = IGK
  51       ENDIF
  52 *
  53 * *** Save original information from /GCKINE/ and /GCTRAK/
  54 *
  55       IPASTO = IPART
  56       TOFSTO = TOFG
  57       DO 10 I = 1,3
  58          VSTO(I) = VERT(I)
  59          PSTO(I) = PVERT(I)
  60    10 CONTINUE
  61 *
  62 * *** Store required tracks in stack JSTAK
  63 *
  64       IVSTO = 0
  65       DO 30 N = N1,N2
  66          IF (IFLGK(N).LT.0) GO TO 30
  67          TOFG  = TOFSTO +TOFD(N)
  68          IPART = GKIN(5,N)
  69          DO 20 I = 1,3
  70             VERT(I)  = GPOS(I,N)
  71             PVERT(I) = GKIN(I,N)
  72    20    CONTINUE
  73          IF (IFLGK(N).EQ.1) THEN
  74             IF (IVSTO.EQ.0) THEN
  75                IVSTO = 1
  76                IFLAG = 1
  77             ELSE
  78                IFLAG = -NVERTX
  79             ENDIF
  80          ELSE
  81             IFLAG = -IFLGK(N)
  82          ENDIF
  83          CALL GSSTAK (IFLAG)
  84          IF (IFLAG.NE.0) THEN
  85             IFLGK(N) = ITR
  86             IFLGK(NGKINE+1) = NVTX
  87          ENDIF
  88    30 CONTINUE
  89 *
  90 * *** Restore original information in /GCKINE/ and /GCTRAK/
  91 *
  92       IPART = IPASTO
  93       TOFG  = TOFSTO
  94       DO 40 I = 1,3
  95          VERT(I)  = VSTO(I)
  96          PVERT(I) = PSTO(I)
  97    40 CONTINUE
  98 *                                                             END GSKING
  99   999 END