GEANT321/gbase/ggclo2.F

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