GEANT321/gbase/ggclos.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1997/11/14 17:44:00  mclareni
   6 * Make sure the maximum angle is greater than the minimun
   7 *
   8 * Revision 1.1.1.1  1995/10/24 10:20:10  cernlib
   9 * Geant
  10 *
  11 *
  12 #include "geant321/pilot.h"
  13 #if !defined(CERNLIB_OLD)
  14 *CMZ :  3.21/04 13/12/94  15.29.27  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, S.Giani  *********           *
  40 C.    *                                                                *
  41 C.    *    Modified by S.Giani for automatic initialization of the new *
  42 C.    *    tracking based on virtual divisions (1993).                 *
  43 C.    *                                                                *
  44 C.    ******************************************************************
  45 C.
  46 #include "geant321/gcbank.inc"
  47 #include "geant321/gcflag.inc"
  48 #include "geant321/gclist.inc"
  49 #include "geant321/gcnum.inc"
  50 #include "geant321/gcunit.inc"
  51 #include "geant321/gcopti.inc"
  52 #include "geant321/gchvir.inc"
  53       CHARACTER*4 NAME
  54       LOGICAL BTEST
  55 C.
  56 C.    ------------------------------------------------------------------
  57       dimension dx(3),tmpmax(7),ndivto(7),qualit(7),ivoaxi(7)
  58       data jfirst/0/
  59       save jfirst
  60       COMMON /QUEST/ IQUEST(100)
  61       COMMON/GCDINA/jphi2,jclow,jchig,jbuff
  62 *
  63 * *** Stop the run in case of serious anomaly during initialization
  64 *
  65       IF (IEORUN.NE.0) THEN
  66          WRITE (CHMAIL, 1001)
  67          CALL GMAIL (0, 0)
  68          STOP
  69       ENDIF
  70 *
  71       IF (NVOLUM.LE.0) THEN
  72          WRITE (CHMAIL, 1002) NVOLUM
  73          CALL GMAIL (0, 0)
  74          GO TO 999
  75       ENDIF
  76 *
  77       NPUSH = NVOLUM -IQ(JVOLUM-2)
  78       CALL MZPUSH (IXCONS, JVOLUM, NPUSH, NPUSH,'I')
  79 *
  80 * *** Loop over volumes, create default JNear banks as relevant,
  81 *      and release unused bank space
  82 *
  83       IDO = 0
  84       DO 80 IVO = 1,NVOLUM
  85          JVO = LQ(JVOLUM-IVO)
  86 *
  87 * *** Check if Tracking medium has been defined
  88 *
  89          NMED=Q(JVO+4)
  90          IF(NMED.LE.0.OR.NMED.GT.IQ(JTMED-2))THEN
  91             WRITE(CHMAIL,1003)IQ(JVOLUM+IVO)
  92             CALL GMAIL (0, 0)
  93          ELSE
  94             IF(LQ(JTMED-NMED).EQ.0)THEN
  95                WRITE(CHMAIL,1003)IQ(JVOLUM+IVO)
  96                CALL GMAIL (0, 0)
  97             ENDIF
  98          ENDIF
  99          IF (BTEST(IQ(JVO),0)) GO TO 80
 100          IDO = 1
 101          IQ(JVO) = IBSET(IQ(JVO),0)
 102          NINL  = IQ(JVO-2)
 103          NIN   = Q(JVO+3)
 104          NUSED = IABS(NIN)
 105          IF (NIN.GT.0) THEN
 106 *           reserve enough additional space for sorted volumes
 107             IF(NIN.LE.1.OR.NIN.GT.500.OR.IOPTIM.LT.0)THEN
 108               NUSED=NUSED+1
 109             ELSE
 110               NUSED=NUSED+2
 111             ENDIF
 112          ENDIF
 113 *
 114          NPUSH = NUSED -NINL
 115          DO 90 IN=NINL,NUSED+1,-1
 116             JIN = LQ(JVO-IN)
 117             IF(JIN.GT.0) THEN
 118                CALL MZDROP(IXCONS,JIN,'L')
 119             ENDIF
 120   90     CONTINUE
 121          CALL MZPUSH (IXCONS, JVO, NPUSH, 0, 'I')
 122          IF (NIN.LE.0) GO TO 80
 123 *
 124          IF(BTEST(IQ(JVO),3)) THEN
 125             IZERO=1
 126          ELSE
 127             IZERO=0
 128          ENDIF
 129          NEL = NIN +IZERO
 130          JN = LQ(JVO-NIN-1)
 131          IF(JN.EQ.0) THEN
 132             CALL MZBOOK (IXCONS,JN,JVO,-NIN-1,'VONE',0,0,NEL+1,2,0)
 133          ENDIF
 134          IQ(JN-5) = IVO
 135          IQ(JN+1) = NEL
 136          JN = JN +1
 137          DO 29 I = 1,NIN
 138             IQ(JN+IZERO+I) = I
 139    29    CONTINUE
 140          IF (IZERO.NE.0) IQ(JN+1) = 0
 141 *
 142    80 CONTINUE
 143 *
 144       IF (IDO.NE.0) THEN
 145 *
 146 * ***    Perform development of JVOLUM structure where necessary
 147 *
 148          CALL GGDVLP
 149 *
 150 * ***    Fill GSORD ordering banks if required
 151 *
 152 * Modified by S.Egli to allow GGORDQ to find the optimum sorting for
 153 * all volumes
 154 *
 155          IF(IOPTIM.GE.1)THEN
 156             WRITE(6,'(A)')' GGCLOS: Start automatic volume ordering:'
 157          ENDIF
 158          DO 91 IVO = 1,NVOLUM
 159             JVO = LQ(JVOLUM-IVO)
 160             NIN = Q(JVO+3)
 161             ISEARC=Q(JVO+1)
 162             IF(ISEARC.GT.0) GO TO 91
 163 *           check if sorting not possible or not wanted
 164             IF(NIN.LE.1.OR.NIN.GT.500.OR.IOPTIM.LT.0)THEN
 165                Q(JVO+1)=0.
 166                IF(NIN.GT.500.AND.IOPTIM.GE.1)THEN
 167                  CALL UHTOC(IQ(JVOLUM+IVO),4,NAME,4)
 168                  WRITE (CHMAIL,1004) NAME,NIN
 169                  CALL  GMAIL (0, 0)
 170                ENDIF
 171             ELSEIF(IOPTIM.EQ.0)THEN
 172                IF(ISEARC.LT.0)CALL GGORD (IVO)
 173             ELSEIF(IOPTIM.EQ.1)THEN
 174                IF(ISEARC.EQ.0) THEN
 175                   CALL GGORDQ(IVO)
 176                ELSE
 177                   CALL GGORD (IVO)
 178                END IF
 179             ELSE
 180                CALL GGORDQ(IVO)
 181             ENDIF
 182    91    CONTINUE
 183 *
 184 * ***    Set status bit for concave volumes
 185 *
 186          CALL GGCAVE
 187 *
 188 * ***    Compute maximum number of levels and of contents per level
 189 *
 190          CALL GGNLEV
 191 *
 192       ENDIF
 193 *
 194 ********************************************************************************
 195 *
 196       if(jfirst.eq.0)then
 197         jfirst=1
 198         call mzlink(ixcons,'/GCHVIR/',jvirt,jvdiv,jcont)
 199         call mzlink(ixstor,'/GCDINA/',jphi2,jbuff,jphi2)
 200       endif
 201       jflag=0
 202       nwjvdi=0
 203       jphi2=0
 204       jclow=0
 205       jchig=0
 206       jbuff=0
 207       if(jvirt.ne.0)call mzdrop(ixcons,jvirt,' ')
 208       nwjvir=5*nvolum+20
 209       call mzneed(ixcons,nwjvir,'G')
 210       if(iquest(11).lt.0)then
 211           print *,'No space for jvirt bank'
 212       else
 213           call mzbook(ixcons,jvirt,jvirt,1,'VIRT',nvolum,nvolum,
 214      +              4*nvolum+20,0,0)
 215       endif
 216       dx(1)=0.
 217       dx(2)=0.
 218       dx(3)=0.
 219       ndivst=0
 220       ndioff=0
 221       ninmax=0
 222       do 101 ivo=1,nvolum
 223         jvo=lq(jvolum-ivo)
 224         call uhtoc(iq(jvolum+ivo),4,NAME,4)
 225 *         print *,'VOLUME ',NAME
 226 *         print *,' '
 227         nin=q(jvo+3)
 228         isearc=q(jvo+1)
 229 *        if(nin.eq.0)then
 230 *          print *,'No daughters.'
 231 *        elseif(nin.lt.0)then
 232 *          print *,'Divided volume.'
 233 *        elseif(nin.le.1)then
 234 *          print *,'Only 1 daughter.'
 235 *        endif
 236  1      continue
 237         if(nin.gt.1)then
 238          if(jflag.eq.0)then
 239           if(iswit(9).eq.12345)then
 240             print *,'VOLUME ',NAME
 241             print *,' '
 242           endif
 243          endif
 244          if(jflag.eq.1)then
 245            q(jvirt+4*(ivo-1)+1)=itmpq
 246            iaxlo=itmpq
 247            iaxhi=itmpq
 248          else
 249            iaxlo=1
 250            iaxhi=7
 251          endif
 252           if(nin.gt.ninmax)then
 253            if(jphi2.ne.0)call mzdrop(ixstor,jphi2,' ')
 254            if(jclow.ne.0)call mzdrop(ixstor,jclow,' ')
 255            if(jchig.ne.0)call mzdrop(ixstor,jchig,' ')
 256            call mzbook(ixstor,jphi2,jphi2,2,'PHI2',0,0,
 257      +                 nin+20,2,-1)
 258            call mzbook(ixstor,jclow,jclow,2,'CLOW',0,0,
 259      +                 nin+20,3,-1)
 260            call mzbook(ixstor,jchig,jchig,2,'CHIG',0,0,
 261      +                 nin+20,3,-1)
 262            if(jflag.eq.1)then
 263              if(jbuff.ne.0)call mzdrop(ixstor,jbuff,' ')
 264              call mzbook(ixstor,jbuff,jbuff,2,'BUFF',0,0,
 265      +                   nin+20,2,-1)
 266            endif
 267           endif
 268          do 110 iaxis=iaxlo,iaxhi
 269           myphif=0
 270 *          print *,'Quality search for axis ',iaxis
 271           ish=q(jvo+2)
 272           if(iaxis.le.3)then
 273             call gvdcar(iaxis,ish,0,q(jvo+7),clmoth,chmoth,ierr)
 274             if(ierr.eq.1.or.(chmoth.le.clmoth))then
 275 *              print *,'Not convenient: abandoned!',iaxis
 276 *              print *,' '
 277               qualit(iaxis)=10000
 278               goto 110
 279             endif
 280           elseif(iaxis.le.5)then
 281             call gvdrad(iaxis,ish,0,dx,q(jvo+7),clmoth,chmoth,ierr)
 282              if(iaxis.eq.5)ierr=1
 283             if(ierr.eq.1.or.(chmoth.le.clmoth))then
 284 *              print *,'Not convenient: abandoned!',iaxis
 285 *              print *,' '
 286               qualit(iaxis)=10000
 287               goto 110
 288             endif
 289           elseif(iaxis.eq.6)then
 290             call gvdphi(ish,0,dx,q(jvo+7),clmoth,chmoth,ierr)
 291             if(ierr.eq.1.or.(chmoth.le.clmoth))then
 292 *              print *,'Not convenient: abandoned!',iaxis
 293 *              print *,' '
 294               qualit(iaxis)=10000
 295               goto 110
 296             elseif((chmoth-clmoth).gt.360..or.chmoth.gt.360)then
 297               print *,'(chmoth-clmoth).gt.360.or.chmoth.gt.360'
 298             elseif((chmoth-clmoth).eq.360.)then
 299               myphif=1
 300             endif
 301           elseif(iaxis.eq.7)then
 302             call gvdthe(ish,0,dx,q(jvo+7),clmoth,chmoth,ierr)
 303             ierr=1
 304             if(ierr.eq.1.or.(chmoth.le.clmoth))then
 305 *              print *,'Not convenient: abandoned!',iaxis
 306 *              print *,' '
 307               qualit(iaxis)=10000
 308               goto 110
 309             endif
 310           endif
 311           if(jflag.eq.1)then
 312             q(jvirt+4*(ivo-1)+3)=clmoth
 313             q(jvirt+4*(ivo-1)+4)=chmoth
 314           endif
 315           thimot=abs(chmoth-clmoth)
 316           thimin=100000.
 317           do 102 in=1,nin
 318             iq(jphi2+in)=0
 319             jin=lq(jvo-in)
 320             call gvdlim(jvo,in,iaxis,clow,chigh,ierr)
 321             if(ierr.eq.1.or.(chigh.le.clow))then
 322 *              if(ierr.eq.0)print *,'Error in gvdlim: corrected',iaxis
 323               clow=clmoth
 324               chigh=chmoth
 325             elseif(myphif.eq.1)then
 326               clowm=clow
 327               chighm=chigh
 328               sg=sign(1.0,clow)
 329               clow=mod(abs(clow),360.0)
 330               if(chigh.ne.360.0)then
 331                if(sg.le.0.0)clow=360.-clow
 332                sg=sign(1.0,chigh)
 333                chigh=mod(abs(chigh),360.0)
 334                if(sg.le.0.0)chigh=360.-chigh
 335               endif
 336               if(chigh.lt.clow)then
 337                 chightf = clow
 338                 clow = chigh
 339                 chigh = chightf
 340                 iq(jphi2+in)=1
 341               endif
 342             elseif(iaxis.eq.6.and.myphif.eq.0)then
 343              if((chigh-chmoth).gt..01.or.(clmoth-clow).gt..01)then
 344                if(clmoth.lt.0..and.clow.gt.0.)then
 345                 clow=clow-360.
 346                 chigh=chigh-360.
 347                 if((chigh-chmoth).gt..01)then
 348                   chigh=chmoth
 349                   if(chigh.le.clow)clow=clmoth
 350                 elseif((clmoth-clow).gt..01)then
 351                   clow=clmoth
 352                   if(clow.ge.chigh)chigh=chmoth
 353                 endif
 354                elseif(chigh.lt.0..and.chmoth.gt.0.)then
 355                 clow=clow+360.
 356                 chigh=chigh+360.
 357                 if((chigh-chmoth).gt..01)then
 358                   chigh=chmoth
 359                   if(chigh.le.clow)clow=clmoth
 360                 elseif((clmoth-clow).gt..01)then
 361                   clow=clmoth
 362                   if(clow.ge.chigh)chigh=chmoth
 363                 endif
 364                endif
 365              endif
 366             endif
 367             if((chigh-chmoth).gt..01)then
 368 *** ONLY FOR DEBUG
 369 *              print *,'iaxis =',iaxis,'protuding daughter',in
 370 **              print *,'myphif =',myphif,'myphi2 =',iq(jphi2+in)
 371 *              print *,'Dhigh=',chigh-chmoth
 372 *              print *,'Dlow=',clmoth-clow
 373 ***
 374               chigh=chmoth
 375               if(chigh.le.clow)clow=clmoth
 376             elseif((clmoth-clow).gt..01)then
 377 *** ONLY FOR DEBUG
 378 *              print *,'iaxis =',iaxis,'protuding daughter',in
 379 **              print *,'myphif =',myphif,'myphi2 =',iq(jphi2+in)
 380 *              print *,'Dhigh=',chigh-chmoth
 381 *              print *,'Dlow=',clmoth-clow
 382 ***
 383               clow=clmoth
 384               if(clow.ge.chigh)chigh=chmoth
 385             endif
 386             q(jclow+in)=clow
 387             q(jchig+in)=chigh
 388             if(iq(jphi2+in).eq.0)then
 389              tmpthi=abs(chigh-clow)
 390             else
 391              tmpthi=abs(chighm-clowm)
 392             endif
 393             if(thimin.gt.tmpthi)thimin=tmpthi
 394  102      continue
 395           if((thimin-thimot).gt.1)then
 396 *            print *,'thimin.gt.thimot',thimin-thimot,'iax=',iaxis
 397             qualit(iaxis)=10000
 398             goto 110
 399           endif
 400           if(thimin.lt.0.04)thimin=0.04
 401           tmpndi=2.*thimot/thimin
 402           nditmp=tmpndi+1
 403 *****          print *,nditmp,' divisions asked for ',nin,' daughters.'
 404 *****           if(nditmp.lt.nin)then
 405 *****             nditmp=nin
 406 *****             print *,'Number of divisions corrected to be = ',nin
 407 *****           endif
 408 *****          if(nditmp.gt.1000.)print *,'1000 divisions are enough.'
 409           ndivto(iaxis)=min(nditmp,1000)
 410           if(jflag.eq.1)then
 411             q(jvirt+4*(ivo-1)+2)=ndivto(iaxis)
 412            jvdiv=lq(jvirt-ivo)
 413            if(jvdiv.ne.0)call mzdrop(ixcons,jvdiv,' ')
 414            nwvili=ndivto(iaxis)+ivoaxi(itmpq)+11
 415            nwjvdi=nwjvdi+nwvili
 416            call mzneed(ixcons,nwvili,'G')
 417            if(iquest(11).lt.0)then
 418             print *,'No space for jvdiv bank',ivo
 419            else
 420             call mzbook(ixcons,jvdiv,jvirt,-ivo,'VLIST',0,0,
 421      +                  nwvili,2,0)
 422            endif
 423           endif
 424           thisli=thimot/ndivto(iaxis)
 425           clslic=clmoth
 426           chslic=clmoth+thisli
 427           avelis=0.
 428           aveave=0.
 429           avesta=0.
 430           ii=0
 431           tmpmax(iaxis)=0.
 432           import=0
 433           if(jflag.eq.1)ioff=ndivto(iaxis)
 434           do 103 i=1,ndivto(iaxis)
 435             j=1
 436             do 104 in=1,nin
 437              if(iq(jphi2+in).eq.0)then
 438               if(q(jchig+in).ge.clslic.and.
 439      +           q(jclow+in).le.chslic)then
 440                 j=j+1
 441                 if(jflag.eq.1)then
 442                   iq(jbuff+j)=in
 443                 endif
 444               endif
 445              else
 446               if(q(jchig+in).ge.clslic.or.
 447      +           q(jclow+in).le.chslic)then
 448                 j=j+1
 449                 if(jflag.eq.1)then
 450                   iq(jbuff+j)=in
 451                 endif
 452               endif
 453              endif
 454  104        continue
 455             inbuf1=j-1
 456             if(jflag.eq.1)then
 457              if(i.gt.1.and.iq(jbuff+1).eq.(j-1))then
 458                if(j-1.eq.0)then
 459                  import=1
 460                elseif(j-1.eq.1)then
 461                  if(iq(jbuff+2).eq.iq(jvdiv+ioff-nposti+2))then
 462                    import=1
 463                  else
 464                    import=0
 465                  endif
 466                else
 467                 import=1
 468                 do 234 ijk=2,nposti-2
 469                  do 432 kji=2,nposti-2
 470                   if(iq(jbuff+ijk).eq.iq(jvdiv+ioff-nposti+kji))then
 471                     goto 234
 472                   endif
 473  432             continue
 474                  import=0
 475                  goto 235
 476  234            continue
 477  235            continue
 478                endif
 479                if(import.eq.1)then
 480                  iq(jvdiv+ioff-nposti+nposti)=i
 481                  iq(jvdiv+i)=ioff-nposti
 482                  goto 145
 483                endif
 484              else
 485                import=0
 486              endif
 487              iq(jbuff+1)=j-1
 488              nposti=j+2
 489              iq(jbuff+j+1)=i
 490              iq(jbuff+j+2)=i
 491              iq(jvdiv+i)=ioff
 492              do 144 m=1,nposti
 493                iq(jvdiv+ioff+m)=iq(jbuff+m)
 494  144         continue
 495              ioff=ioff+nposti
 496             else
 497              aveinc=j+2
 498              avesta=avesta+aveinc
 499             endif
 500  145        continue
 501             if(inbuf1.gt.tmpmax(iaxis))then
 502              tmpmax(iaxis)=inbuf1
 503             endif
 504             if(inbuf1.ne.0.)ii=ii+1
 505             avelis=avelis+inbuf1
 506             clslic=chslic
 507             chslic=clslic+thisli
 508  103      continue
 509           if(jflag.eq.1)then
 510              ndioff=ndioff+ioff
 511              if(iswit(9).eq.12345)then
 512               print *,'words booked =',nwvili,'; words used =',ioff
 513               print *,' '
 514           endif
 515 *** ONLY FOR DEBUG
 516 **             mymyof=0
 517 **             do 2 mm=1,ndivto(iaxis)
 518 **               myoff=iq(jvdiv+mm)
 519 **              if(myoff.ne.mymyof)then
 520 **               if(iq(jvdiv+myoff+1).eq.0)then
 521 **                 print *,'Lower div =',iq(jvdiv+myoff+2)
 522 **                 print *,'Upper div =',iq(jvdiv+myoff+3)
 523 **               elseif(iq(jvdiv+myoff+1).eq.1)then
 524 **                 print *,'Lower div =',iq(jvdiv+myoff+3)
 525 **                 print *,'Upper div =',iq(jvdiv+myoff+4)
 526 **               endif
 527 **             endif
 528 **               mymyof=iq(jvdiv+mm)
 529 ** 2           continue
 530 ***
 531           endif
 532           if(ii.eq.0)then
 533             print *,iaxis,'=iax: not filled divisions: error!'
 534             print *,' '
 535             aveave=10000
 536             avelis=10000
 537             goto 105
 538           endif
 539           if(jflag.eq.0)then
 540             ivoaxi(iaxis)=avesta
 541           endif
 542           aveave=avelis/ndivto(iaxis)
 543           avelis=avelis/ii
 544  105      continue
 545           qualit(iaxis)=avelis
 546 *** ONLY FOR DEBUG
 547 **      print *,'Max n. of objects per div = ',tmpmax(iaxis)
 548 **      print *,'Aver. n. of obj. per not-empty div = ',avelis
 549 **      print *,'Average n. of objects per div = ',aveave
 550 **            print *,' '
 551 ***
 552  110     continue
 553         if(jflag.eq.0)then
 554          tmpq=10000
 555          tmpm=10000
 556          itmpq=0
 557          itmpm=0
 558          do 111 iaxis=1,7
 559           if(qualit(iaxis).lt.tmpq)then
 560            tmpq=qualit(iaxis)
 561            itmpq=iaxis
 562           endif
 563           if(tmpmax(iaxis).lt.tmpm)then
 564            tmpqm=tmpmax(iaxis)
 565            itmpm=iaxis
 566           endif
 567  111     continue
 568          if(iswit(9).eq.12345)then
 569           print *,'nin=',nin,' iax=',itmpq,' ndiv=',ndivto(itmpq)
 570           print *,'Max n. of objects per div = ',tmpmax(itmpq)
 571           print *,'Average n. of objects per div = ',tmpq
 572          endif
 573 *** ONLY FOR DEBUG
 574 **         if(isearc.lt.0)then
 575 **           jsb=lq(lq(jvo-nin-1))
 576 **           iaxor=q(jsb+1)
 577 **           ndivor=q(jsb+2)-1
 578 **           jsco=lq(jvo-nin-2)
 579 **           tmpqor=0.
 580 **           tmpmor=0.
 581 **           do 133 idivor=1,ndivor
 582 **             if(iq(jsco+idivor).gt.tmpmor)tmpmor=iq(jsco+idivor)
 583 **             tmpqor=tmpqor+iq(jsco+idivor)
 584 ** 133       continue
 585 **           tmpqor=tmpqor/ndivor
 586 **           print *,'Gsord: iax=',iaxor,' ndiv=',ndivor
 587 **           print *,'Gsord: Max n. of obj. per div = ',tmpmor
 588 **           print *,'Gsord: Aver. n. of obj. per div = ',tmpqor
 589 **         endif
 590 ***
 591          ndivst=ndivst+(ndivto(itmpq)+ndivto(itmpq)*(3.+tmpq)+10.)
 592          jflag=1
 593          goto 1
 594         else
 595           jflag=0
 596 *** ONLY FOR DEBUG
 597 **          print *,'nin=',nin,' iax=',q(jvirt+4*(ivo-1)+1),' ndiv=',
 598 **     +q(jvirt+4*(ivo-1)+2)
 599 **          ittmp=0
 600 **          iind=q(jvirt+4*(ivo-1)+2)
 601 **          do 155 n=1,iind
 602 **           jvdiv=lq(jvirt-ivo)
 603 **           iofset=iq(jvdiv+n)
 604 **           nnobj=iq(jvdiv+iofset+1)
 605 **           if(nnobj.gt.ittmp)ittmp=nnobj
 606 ** 155      continue
 607 **          print *,'Max n. of objects per div = ',ittmp
 608 **          print *,' '
 609 **          print *,' '
 610 ***
 611         endif
 612         endif
 613         if(nin.gt.ninmax)ninmax=nin
 614  101  continue
 615        nwtota=ndivst+nvolum*5+10.
 616        if(iswit(9).eq.12345)then
 617         print *,'Computed number of words foreseen = ',nwtota
 618        endif
 619        nwreal=nwjvir+nwjvdi
 620        if(iswit(9).eq.12345)then
 621         print *,'Computed number of words booked = ',nwreal
 622        endif
 623        nwneed=nwjvir+ndioff
 624        if(iswit(9).eq.12345)then
 625         print *,'Computed number of words needed = ',nwneed
 626        endif
 627        if(jphi2.ne.0)call mzdrop(ixstor,jphi2,' ')
 628        if(jclow.ne.0)call mzdrop(ixstor,jclow,' ')
 629        if(jchig.ne.0)call mzdrop(ixstor,jchig,' ')
 630        if(jbuff.ne.0)call mzdrop(ixstor,jbuff,' ')
 631 *
 632 ********************************************************************************
 633 *
 634 * *** Scan the volume structure to retrieve the path through
 635 *      the physical tree for all sensitive detectors
 636 *
 637        CALL GHCLOS
 638 *
 639 * *** Books STAT banks if data card STAT is submitted
 640 *
 641       IF (NSTAT.GT.0)  CALL GBSTAT
 642 *
 643       CALL MZGARB (IXCONS, 0)
 644 *
 645  1001 FORMAT (' Severe diagnostic in initialization phase. STOP')
 646  1002 FORMAT (' GGCLOS : NVOLUM =',I5,' *****')
 647  1003 FORMAT (' Illegal tracking medium number in volume : ',A4)
 648  1004 FORMAT (' GGORDQ : Volume ',A4,' has more than 500 (',
 649      +        I3,') daughters ; volume sorting not possible !')
 650 *                                                             END GGCLOS
 651   999 END
 652
 653 #endif