GEANT321/ghits/gfdigi.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:09  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 GFDIGI(IUSET,IUDET,NTDIM,NVDIM,NDDIM,NDMAX,NUMVS
  13      +,                 LTRA,NTRA,NUMBV,KDIGI,NDIGS)
  14 C.
  15 C.    ******************************************************************
  16 C.    *                                                                *
  17 C.    *                                                                *
  18 C.    *   Returns  the   digitisations  for   the  physical   volume   *
  19 C.    * specified by the  list NUMVS with generic  volume name IUDET   *
  20 C.    * belonging to set IUSET.                                        *
  21 C.    * IUSET     user set identifier                                  *
  22 C.    * IUDET     user    detector   identifier    (name   of    the   *
  23 C.    *           corresponding sensitive volume)                      *
  24 C.    * NTDIM     1st  dimension of  LTRA  (max.   number of  tracks   *
  25 C.    *           contributing)                                        *
  26 C.    * NVDIM     1st  dimension of  NUMVS,  NUMBV  (usually =NV, the  *
  27 C.    *           number of volume descriptors which permit to iden-   *
  28 C.    *           tify a given detector, possibly smaller than NV)     *
  29 C.    * NDDIM     1st dimension of KDIGI (argument ND of GSDETD)       *
  30 C.    * NDMAX     is  the  maximum  number of  digitisations  to  be   *
  31 C.    *           returned                                             *
  32 C.    * NUMVS     is a  1-Dim array that  must contain on  input the   *
  33 C.    *           geometric  path  of  the  detector  volume  to  be   *
  34 C.    *           selected.                                            *
  35 C.    *           All 0  interpreted as  'all physical  volumes with   *
  36 C.    *           generic name IUDET'                                  *
  37 C.    * LTRA      is a 2-Dim  array that will contain  on output for   *
  38 C.    *           each digitisation the numbers  of the tracks which   *
  39 C.    *           have produced it                                     *
  40 C.    * NTRA      is a 1-Dim  array that will contain  on output for   *
  41 C.    *           each  digitisation  the  total  number  of  tracks   *
  42 C.    *           contributing.                                        *
  43 C.    *           In case this  number is greater than  NTDIM,  only   *
  44 C.    *           the  first  NTDIM  corresponding   tracks  can  be   *
  45 C.    *           returned on LTRA                                     *
  46 C.    * NUMBV     is a 2-Dim  array that will contain  on output for   *
  47 C.    *           each digitisation the list of volume numbers which   *
  48 C.    *           identify each physical volume                        *
  49 C.    * KDIGI     is  a 2-Dim  array  that  will contain  the  NDIGI   *
  50 C.    *           digitisations                                        *
  51 C.    * NDIGI     is  the  total  number of  digitisations  in  this   *
  52 C.    *           detector.                                            *
  53 C.    *           In  case  the  total number  of  digitisations  is   *
  54 C.    *           greater than NDMAX,   NDIGI is set to  NDMAX+1 and   *
  55 C.    *           only NDMAX digitisations are returned                *
  56 C.    *     -  KDIGI(1,I)  =  digitisation type  1 for  digitisation   *
  57 C.    *   number I                                                     *
  58 C.    *     - NUMBV(1,I) = volume number 1 for digitisation number I   *
  59 C.    *     -  LTRA (1,I)   =  first  track number  contributing  to   *
  60 C.    *   digitisation number I                                        *
  61 C.    *   In the calling  routine,  the arrays LTRA,   NTRA,  NUMVS,   *
  62 C.    * NUMBV, KDIGI must be dimensioned to:                           *
  63 C.    *    LTRA (NTDIM,NDMAX)                                          *
  64 C.    *    NTRA (NDMAX)                                                *
  65 C.    *    NUMVS(NVDIM)                                                *
  66 C.    *    NUMBV(NVDIM,NDMAX)                                          *
  67 C.    *    KDIGI(NDDIM,NDMAX)                                          *
  68 C.    *                                                                *
  69 C.    *    ==>Called by : <USER>                                       *
  70 C.    *       Author    W.Gebel  *********                             *
  71 C.    *                                                                *
  72 C.    ******************************************************************
  73 C.
  74 #include "geant321/gcbank.inc"
  75       PARAMETER (NVMAX=20)
  76       DIMENSION NUMVT(NVMAX),NUMVS(NVDIM),NUMBV(NVDIM,1)
  77       DIMENSION LTRA(NTDIM,1),NTRA(1),KDIGI(NDDIM,1)
  78       EQUIVALENCE (WS(1),NUMVT(1))
  79       CHARACTER*4 IUSET,IUDET
  80 C.
  81 C.    --------------------------------------------------------------------------
  82 C.
  83 C             Find if selected set, detector exists
  84 C
  85       NDIGS=0
  86       IF(JDIGI.LE.0)GO TO 999
  87       NSET=IQ(JSET-1)
  88       CALL GLOOK(IUSET,IQ(JSET+1),NSET,ISET)
  89       IF(ISET.LE.0)GO TO 999
  90 C
  91       JS=LQ(JSET-ISET)
  92       JDI=LQ(JDIGI-ISET)
  93       IF(JS.LE.0)GO TO 999
  94       IF(JDI.LE.0)GO TO 999
  95       NDET=IQ(JS-1)
  96       CALL GLOOK(IUDET,IQ(JS+1),NDET,IDET)
  97       IF(IDET.EQ.0)GO TO 999
  98 C
  99       JD=LQ(JS-IDET)
 100       JDID=LQ(JDI-IDET)
 101       IF(JDID.LE.0)GO TO 999
 102       JDDI=LQ(JD-2)
 103 C
 104       ILAST=IQ(JDI+IDET)
 105       IF(ILAST.EQ.0)GO TO 999
 106       NV=IQ(JD+2)
 107       ND=IQ(JD+6)
 108 C
 109 C
 110 C             Loop on all digits
 111 C
 112 C
 113       IDIG=0
 114       I=0
 115       NWDI=0
 116 C
 117    10 CONTINUE
 118       I=I+NWDI
 119       IF(I.GE.ILAST)GO TO 110
 120       NWDI=IQ(JDID+I+1)
 121       NK=2
 122 C
 123       NTRM1= IBITS(IQ(JDID+I+NK),0,16)
 124       NTRT = NTRM1+1
 125       NWTR = NTRT/2+1
 126       NK   = NK+NWTR
 127 C
 128 C             Find the selected volume
 129 C             (if NO volumes exist take ALL digits)
 130 C
 131       IF(NV.GT.0)THEN
 132          K=1
 133          DO 40 IV=1,NV
 134             NB=IQ(JD+2*IV+10)
 135             IF(NB.LE.0)THEN
 136                IF(K.GT.1)THEN
 137                    K=1
 138                    NK=NK+1
 139                ENDIF
 140                IF(IV.LE.NVMAX)NUMVT(IV)=IQ(JDID+I+NK)
 141                IF(IV.NE.NV)NK=NK+1
 142             ELSE
 143                IF(K+NB.GT.33)THEN
 144                   K=1
 145                   NK=NK+1
 146                ENDIF
 147                IF(IV.LE.NVMAX)NUMVT(IV)=IBITS(IQ(JDID+I+NK),K-1,NB)
 148                K=K+NB
 149             ENDIF
 150             IF(IV.LE.NVDIM)THEN
 151                IF(NUMVS(IV).NE.0)THEN
 152                   IF(NUMVS(IV).NE.NUMVT(IV))GO TO 10
 153                ENDIF
 154             ENDIF
 155    40    CONTINUE
 156          NK=NK+1
 157       ENDIF
 158 C
 159 C
 160 C
 161 C ========>   Now store number of tracks and volume numbers,
 162 C             and fetch track numbers and digits
 163 C
 164       IDIG=IDIG+1
 165       IF(IDIG.GT.NDMAX)GO TO 110
 166 C
 167       NTRA(IDIG)=NTRT
 168       NVMIN=MIN(NV,NVDIM)
 169       CALL VZERO (NUMBV(1,IDIG),NVDIM)
 170       CALL UCOPY (NUMVT(1),NUMBV(1,IDIG),NVMIN)
 171 C
 172 C             Get track numbers
 173 C
 174       MK=NK
 175       NK=2
 176       IF(NTRT.GT.0)THEN
 177          IF(NTRM1.GE.1)THEN
 178             DO 54 ITR=1,NTRM1,2
 179                IF(ITR.LE.NTDIM)THEN
 180                   LTRA(ITR ,IDIG)=IBITS(IQ(JDID+I+NK),16,16)
 181                ENDIF
 182                NK=NK+1
 183                IF(ITR.LT.NTDIM)THEN
 184                   LTRA(ITR+1,IDIG)=IBITS(IQ(JDID+I+NK), 0,16)
 185                ENDIF
 186    54       CONTINUE
 187          ENDIF
 188          IF(NTRT.LE.NTDIM)THEN
 189            IF(MOD(NTRT,2).EQ.1)
 190      +               LTRA(NTRT,IDIG)=IBITS(IQ(JDID+I+NK),16,16)
 191          ENDIF
 192       ENDIF
 193       NK=MK
 194 C
 195 C             Get unpacked digits
 196 C
 197       IF(ND.LE.0)GO TO 10
 198       K=1
 199       DO 90 ID=1,ND
 200          NB=IQ(JDDI+2*ID)
 201          IF(NB.LE.0)THEN
 202             IF(K.GT.1)THEN
 203                 K=1
 204                 NK=NK+1
 205             ENDIF
 206             IF(ID.LE.NDDIM)KDIGI(ID,IDIG)=IQ(JDID+I+NK)
 207             IF(ID.NE.ND)NK=NK+1
 208          ELSE
 209             IF(K+NB.GT.33)THEN
 210                K=1
 211                NK=NK+1
 212             ENDIF
 213             IF(ID.LE.NDDIM)KDIGI(ID,IDIG)=IBITS(IQ(JDID+I+NK),K-1,NB)
 214             K=K+NB
 215          ENDIF
 216   90  CONTINUE
 217 C
 218       GO TO 10
 219 C
 220  110  NDIGS=IDIG
 221 C
 222  999  RETURN
 223       END