GEANT321/gbase/ggclo2.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1999/05/18 15:55:16  fca
   6 * AliRoot sources
   7 *
   8 * Revision 1.1.1.1  1995/10/24 10:20:11  cernlib
   9 * Geant
  10 *
  11 *
  12 #include "geant321/pilot.h"
  13 #if defined(CERNLIB_OLD)
  14 *CMZ :  3.21/02 29/03/94  15.41.19  by  S.Giani
  15 *-- Author :
  16       SUBROUTINE GGCLOS
  17 C.
  18 C.    ******************************************************************
  19 C.    *                                                                *
  20 C.    *    Closes off the geometry setting.                            *
  21 C.    *    Initializes the search list for the contents of each        *
  22 C.    *    volume following the order they have been positioned, and   *
  23 C.    *    inserting the content '0' when a call to GSNEXT (-1) has    *
  24 C.    *    been required by the user.                                  *
  25 C.    *    Performs the development of the JVOLUM structure for all    *
  26 C.    *    volumes with variable parameters, by calling GGDVLP.        *
  27 C.    *    Interprets the user calls to GSORD, through GGORD.          *
  28 C.    *    Computes and stores in a bank (next to JVOLUM mother bank)  *
  29 C.    *    the number of levels in the geometrical tree and the        *
  30 C.    *    maximum number of contents per level, by calling GGNLEV.    *
  31 C.    *    Sets status bit for CONCAVE volumes, through GGCAVE.        *
  32 C.    *    Completes the JSET structure with the list of volume names  *
  33 C.    *    which identify uniquely a given physical detector, the      *
  34 C.    *    list of bit numbers to pack the corresponding volume copy   *
  35 C.    *    numbers, and the generic path(s) in the JVOLUM tree,        *
  36 C.    *    through the routine GHCLOS.                                 *
  37 C.    *                                                                *
  38 C.    *    Called by : <USER>                                          *
  39 C.    *    Authors   : R.Brun, F.Bruyant  *********                    *
  40 C.    *                                                                *
  41 C.    *    Modified by S.Egli at 15.9.90: automatic sorting of volumes *
  42 C     *    done by calling GGORDQ for each volume                      *
  43 C.    ******************************************************************
  44 C.
  45 #include "geant321/gcbank.inc"
  46 #include "geant321/gcflag.inc"
  47 #include "geant321/gclist.inc"
  48 #include "geant321/gcnum.inc"
  49 #include "geant321/gcunit.inc"
  50 #include "geant321/gcopti.inc"
  51       CHARACTER*4 NAME
  52       LOGICAL BTEST
  53 C.
  54 C.    ------------------------------------------------------------------
  55 C.
  56 *
  57 * *** Stop the run in case of serious anomaly during initialization
  58 *
  59       IF (IEORUN.NE.0) THEN
  60          WRITE (CHMAIL, 1001)
  61          CALL GMAIL (0, 0)
  62          STOP
  63       ENDIF
  64 *
  65       IF (NVOLUM.LE.0) THEN
  66          WRITE (CHMAIL, 1002) NVOLUM
  67          CALL GMAIL (0, 0)
  68          GO TO 999
  69       ENDIF
  70 *
  71       NPUSH = NVOLUM -IQ(JVOLUM-2)
  72       CALL MZPUSH (IXCONS, JVOLUM, NPUSH, NPUSH,'I')
  73 *
  74 * *** Loop over volumes, create default JNear banks as relevant,
  75 *      and release unused bank space
  76 *
  77       IDO = 0
  78       DO 80 IVO = 1,NVOLUM
  79          JVO = LQ(JVOLUM-IVO)
  80 *
  81 * *** Check if Tracking medium has been defined
  82 *
  83          NMED=Q(JVO+4)
  84          IF(NMED.LE.0.OR.NMED.GT.IQ(JTMED-2))THEN
  85             WRITE(CHMAIL,1003)IQ(JVOLUM+IVO)
  86             CALL GMAIL (0, 0)
  87          ELSE
  88             IF(LQ(JTMED-NMED).EQ.0)THEN
  89                WRITE(CHMAIL,1003)IQ(JVOLUM+IVO)
  90                CALL GMAIL (0, 0)
  91             ENDIF
  92          ENDIF
  93          IF (BTEST(IQ(JVO),0)) GO TO 80
  94          IDO = 1
  95          IQ(JVO) = IBSET(IQ(JVO),0)
  96          NINL  = IQ(JVO-2)
  97          NIN   = Q(JVO+3)
  98          NUSED = IABS(NIN)
  99          IF (NIN.GT.0) THEN
 100 *           reserve enough additional space for sorted volumes
 101             IF(NIN.LE.1.OR.NIN.GT.500.OR.IOPTIM.LT.0)THEN
 102               NUSED=NUSED+1
 103             ELSE
 104               NUSED=NUSED+2
 105             ENDIF
 106          ENDIF
 107 *
 108          NPUSH = NUSED -NINL
 109          DO 90 IN=NINL,NUSED+1,-1
 110             JIN = LQ(JVO-IN)
 111             IF(JIN.GT.0) THEN
 112                CALL MZDROP(IXCONS,JIN,'L')
 113             ENDIF
 114   90     CONTINUE
 115          CALL MZPUSH (IXCONS, JVO, NPUSH, 0, 'I')
 116          IF (NIN.LE.0) GO TO 80
 117 *
 118          IF(BTEST(IQ(JVO),3)) THEN
 119             IZERO=1
 120          ELSE
 121             IZERO=0
 122          ENDIF
 123          NEL = NIN +IZERO
 124          JN = LQ(JVO-NIN-1)
 125          IF(JN.EQ.0) THEN
 126             CALL MZBOOK (IXCONS,JN,JVO,-NIN-1,'VONE',0,0,NEL+1,2,0)
 127          ENDIF
 128          IQ(JN-5) = IVO
 129          IQ(JN+1) = NEL
 130          JN = JN +1
 131          DO 29 I = 1,NIN
 132             IQ(JN+IZERO+I) = I
 133    29    CONTINUE
 134          IF (IZERO.NE.0) IQ(JN+1) = 0
 135 *
 136    80 CONTINUE
 137 *
 138       IF (IDO.NE.0) THEN
 139 *
 140 * ***    Perform development of JVOLUM structure where necessary
 141 *
 142          CALL GGDVLP
 143 *
 144 * ***    Fill GSORD ordering banks if required
 145 *
 146 * Modified by S.Egli to allow GGORDQ to find the optimum sorting for
 147 * all volumes
 148 *
 149          IF(IOPTIM.GE.1)THEN
 150             WRITE(6,'(A)')' GGCLOS: Start automatic volume ordering:'
 151          ENDIF
 152          DO 91 IVO = 1,NVOLUM
 153             JVO = LQ(JVOLUM-IVO)
 154             NIN = Q(JVO+3)
 155             ISEARC=Q(JVO+1)
 156             IF(ISEARC.GT.0) GO TO 91
 157 *           check if sorting not possible or not wanted
 158             IF(NIN.LE.1.OR.NIN.GT.500.OR.IOPTIM.LT.0)THEN
 159                Q(JVO+1)=0.
 160                IF(NIN.GT.500.AND.IOPTIM.GE.1)THEN
 161                  CALL UHTOC(IQ(JVOLUM+IVO),4,NAME,4)
 162                  WRITE (CHMAIL,1004) NAME,NIN
 163                  CALL  GMAIL (0, 0)
 164                ENDIF
 165             ELSEIF(IOPTIM.EQ.0)THEN
 166                IF(ISEARC.LT.0)CALL GGORD (IVO)
 167             ELSEIF(IOPTIM.EQ.1)THEN
 168                IF(ISEARC.EQ.0) THEN
 169                   CALL GGORDQ(IVO)
 170                ELSE
 171                   CALL GGORD (IVO)
 172                END IF
 173             ELSE
 174                CALL GGORDQ(IVO)
 175             ENDIF
 176    91    CONTINUE
 177 *
 178 * ***    Set status bit for concave volumes
 179 *
 180          CALL GGCAVE
 181 *
 182 * ***    Compute maximum number of levels and of contents per level
 183 *
 184          CALL GGNLEV
 185 *
 186       ENDIF
 187 *
 188 * *** Scan the volume structure to retrieve the path through
 189 *      the physical tree for all sensitive detectors
 190 *
 191        CALL GHCLOS
 192 *
 193 * *** Books STAT banks if data card STAT is submitted
 194 *
 195       IF (NSTAT.GT.0)  CALL GBSTAT
 196 *
 197       CALL MZGARB (IXCONS, 0)
 198 *
 199  1001 FORMAT (' Severe diagnostic in initialization phase. STOP')
 200  1002 FORMAT (' GGCLOS : NVOLUM =',I5,' *****')
 201  1003 FORMAT (' Illegal tracking medium number in volume : ',A4)
 202  1004 FORMAT (' GGORDQ : Volume ',A4,' has more than 500 (',
 203      +        I3,') daughters ; volume sorting not possible !')
 204 *                                                             END GGCLOS
 205   999 END
 206 #else
 207       SUBROUTINE GGCLO2_DUMMY
 208       END
 209 #endif