GEANT321/gkine/gsvert.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1998/02/10 16:04:21  japost
   6 *   Comments are correctly redistributed.
   7 *
   8 * Revision 1.1.1.1  1995/10/24 10:21:19  cernlib
   9 * Geant
  10 *
  11 *
  12 #include "geant321/pilot.h"
  13 *CMZ :  3.21/02 29/03/94  15.41.21  by  S.Giani
  14 *-- Author :
  15       SUBROUTINE GSVERT(V,NTBEAM,NTTARG,UBUF,NWBUF,NVTX)
  16 C.
  17 C.    ******************************************************************
  18 C.    *                                                                *
  19 C     *       Creates a new vertex bank                                *
  20 C     *       Vertex is generated from tracks NTBEAM NTTARG            *
  21 C     *       NVTX is the new vertex number                            *
  22 C.    *                                                                *
  23 C.    *                                                                *
  24 C.    * In detail:                                                     *
  25 C.    *                                                                *
  26 C.    *  Stores vertex parameters.                                     *
  27 C.    *                                                                *
  28 C.    *  Input:                                                        *
  29 C.    *    V         array of (x,y,z) position of the vertex           *
  30 C.    *    NTBEAM    beam track number origin of the vertex            *
  31 C.    *            =0 if none exists                                   *
  32 C.    *    NTTARG    target track number origin of the vertex          *
  33 C.    *    UBUF      user array of NUBUF floating point numbers        *
  34 C.    *    NUBUF                                                       *
  35 C.    *                                                                *
  36 C.    *  Output:                                                       *
  37 C.    *    NVTX      new vertex number (=0 in case of error).          *
  38 C.    *                                                                *
  39 C.    *    ==>Called by : <USER>, GUKINE,GUSTEP                        *
  40 C.    *       Authors    R.Brun, F.Carena, M.Hansroul  *********       *
  41 C.    *                                                                *
  42 C.    ******************************************************************
  43 C.
  44 #include "geant321/gcbank.inc"
  45 #include "geant321/gcnum.inc"
  46 #include "geant321/gcpush.inc"
  47 #include "geant321/gctrak.inc"
  48       DIMENSION V(3),UBUF(1)
  49 C.
  50 C.    ------------------------------------------------------------------
  51 C.
  52       NVTX   = NVERTX + 1
  53       IF (JVERTX.EQ.0)THEN
  54          CALL MZBOOK(IXDIV,JVERTX,JVERTX,1,'VERT',NCVERT,NCVERT,1,2,0)
  55          IQ(JVERTX-5)=0
  56       ENDIF
  57       IF(NVTX.GT.IQ(JVERTX-2)) CALL MZPUSH(IXDIV,JVERTX,NPVERT,0,'I')
  58 C
  59       CALL MZBOOK(IXDIV,JV,JVERTX,-NVTX,'VERT',1,1,9,3,0)
  60 C
  61       IF(NWBUF.GT.0)THEN
  62          CALL MZBOOK(IXDIV,JUV,JV,-1,'VERU',0,0,NWBUF,3,0)
  63          IQ(JUV-5)=NVTX
  64          DO 3 I=1,NWBUF
  65    3     Q(JUV+I)=UBUF(I)
  66       ENDIF
  67       DO 4 I=1,3
  68    4  Q(JV + I) = V(I)
  69       Q(JV + 4) = TOFG
  70       Q(JV + 5) = NTBEAM
  71       Q(JV + 6) = NTTARG
  72       NTK=0
  73       IF(JKINE.GT.0)NTK=IQ(JKINE-2)
  74       IF(NTBEAM.GT.NTK)GO TO 90
  75       IF(NTBEAM.LT.0)GO TO 90
  76       IF(NTTARG.GT.NTK)GO TO 90
  77       IF(NTTARG.LT.0)GO TO 90
  78       IF(NTBEAM.NE.0)THEN
  79          JK = LQ(JKINE- NTBEAM)
  80          IF(JK.EQ.0)GO TO 90
  81          NVG = Q(JK + 7)
  82          NFREE=IQ(JK-1)-7-NVG
  83          IF(NFREE.LE.0)CALL MZPUSH(IXDIV,JK,0,2,'I')
  84          Q(JK + NVG + 8) = NVTX
  85          Q(JK + 7) = NVG + 1
  86       ENDIF
  87 C
  88       IF(NTTARG.NE.0)THEN
  89          JK = LQ(JKINE- NTTARG)
  90          NVG = Q(JK + 7)
  91          NFREE=IQ(JK-1)-7-NVG
  92          IF(NFREE.LE.0)CALL MZPUSH(IXDIV,JK,0,2,'I')
  93          Q(JK + NVG + 8) = NVTX
  94          Q(JK + 7) = NVG + 1
  95       ENDIF
  96 C
  97       NVERTX = NVTX
  98       IQ(JVERTX+1)=NVERTX
  99       GO TO 99
 100 C
 101 C             Error
 102 C
 103   90  NVTX   = 0
 104   99  RETURN
 105       END