GEANT321/ghits/grhits.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:11  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.20  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GRHITS (IUSET, IUDET, NTRA, ITRA)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *    SUBR. GRHITS (IUSET, IUDET, NTRA, ITRA)                     *
  17 C.    *                                                                *
  18 C.    *   Removes the hits produced by the tracks ITRA(1...NTRA) in    *
  19 C.    *   the generic volume name IUDET belonging to the set IUSET.    *
  20 C.    *                                                                *
  21 C.    *   IUSET    User set identifier                                 *
  22 C.    *   IUDET    User detector identifier (name of the corresponding *
  23 C.    *            sensivitive volume)                                 *
  24 C.    *   NTRA     Number of tracks whose hits are to be removed       *
  25 C.    *   ITRA     Track indices whose hits are to be removed          *
  26 C.    *                                                                *
  27 C.    *   Called by : <USER>                                           *
  28 C.    *   Author    : S.Banerjee                                       *
  29 C.    *                                                                *
  30 C.    ******************************************************************
  31 C.
  32 #include "geant321/gcbank.inc"
  33       COMMON /GC1HIT/ LOC(2), JD, JDH, JH, JHD, JHDN, JS
  34       DIMENSION       ITRA(*)
  35       CHARACTER*(*)   IUSET, IUDET
  36       SAVE JHDNN
  37       DATA JHDNN/0/
  38 *
  39 *     ------------------------------------------------------------------
  40 *
  41       IF (NTRA.LE.0)                  GO TO 999
  42       IF (JSET.LE.0)                  GO TO 999
  43       IF (JHITS.LE.0)                 GO TO 999
  44 *
  45 * *** Find the selected set(s)
  46 *
  47       NSET  = IQ(JSET-1)
  48       IF (IUSET(1:1).EQ.'*') THEN
  49          NS1   = 1
  50          NS2   = NSET
  51       ELSE
  52          CALL GLOOK (IUSET, IQ(JSET+1), NSET, ISET)
  53          IF (ISET.LE.0)               GO TO 999
  54          NS1   = ISET
  55          NS2   = ISET
  56       ENDIF
  57       CALL MZLINT (IXSTOR, '/GC1HIT/', LOC, JD, JS)
  58 *
  59 * *** Loop over selected sets
  60 *
  61       DO 30  ISET = NS1, NS2
  62          JS    = LQ(JSET-ISET)
  63          JH    = LQ(JHITS-ISET)
  64          IF (JS.LE.0.OR.JH.LE.0)      GO TO 30
  65          NDET  = IQ(JS-1)
  66 *
  67 *  **    Find the selected detector(s)
  68 *
  69          IF (IUDET(1:1).EQ.'*') THEN
  70             ND1   = 1
  71             ND2   = NDET
  72          ELSE
  73             CALL GLOOK (IUDET, IQ(JS+1), NDET, IDET)
  74             IF (IDET.EQ.0)            GO TO 30
  75             ND1   = IDET
  76             ND2   = IDET
  77          ENDIF
  78 *
  79 *  **    Loop over selected detectors
  80 *
  81          DO 20 IDET = ND1, ND2
  82             JD    = LQ(JS-IDET)
  83             JHD   = LQ(JH-IDET)
  84             IF (JD.LE.0)              GO TO 20
  85             IF (JHD.LE.0)             GO TO 20
  86             JDH   = LQ(JD-1)
  87             IF (JDH.LE.0)             GO TO 20
  88             ILAST = IQ(JH+IDET)
  89             IF (ILAST.EQ.0)           GO TO 20
  90             NW    = IQ(JD+1) + IQ(JD+3) + 1
  91 *
  92 *  **       Shunt the original bank and lift a new SJDH bank
  93 *
  94             CALL ZSHUNT (IXDIV, JHD, JHDNN, 2, 0)
  95             CALL MZBOOK (IXDIV, JHDN, JH, -IDET, 'SJHD', 0, 0, ILAST,
  96      +                   1, -1)
  97             IQ(JHDN-5) = IQ(JHD-5)
  98 *
  99 *  **       Copy the relevant part
 100 *
 101             LAST  = 0
 102             DO 10 I = 1, ILAST, NW
 103                II    = IUCOMP (IQ(JHD+I), ITRA, NTRA)
 104                IF (II.LE.0) THEN
 105                   CALL UCOPY (IQ(JHD+I), IQ(JHDN+LAST+1), NW)
 106                   LAST  = LAST + NW
 107                ENDIF
 108    10       CONTINUE
 109 *
 110 *  **       Drop the old bank
 111 *
 112             IF (LAST.LT.ILAST) THEN
 113                CALL VZERO (IQ(JHDN+LAST+1), ILAST-LAST)
 114             ENDIF
 115             IQ(JH+IDET) = LAST
 116             CALL MZDROP (IXDIV, JHD, ' ')
 117    20    CONTINUE
 118    30 CONTINUE
 119 *
 120   100 LOC(1) = 0
 121 *                                                             END GRHITS
 122   999 END