GEANT321/ggeom/ggordq.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:49  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.28  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GGORDQ (IVO)
  13 C.
  14 C.    *****************************************************************
  15 C.    *                                                               *
  16 C.    *    Find and order the boundaries of the contents of the       *
  17 C.    *    IVOth volume, with respect to coordinate IAX :             *
  18 C.    *           IAX = 1    X Axis                                   *
  19 C.    *           IAX = 2    Y Axis                                   *
  20 C.    *           IAX = 3    Z Axis                                   *
  21 C.    *           IAX = 4    Rxy                                      *
  22 C.    *           IAX = 5    Rxyz                                     *
  23 C.    *           IAX = 6    PHI   (PHI=0 => X axis)                  *
  24 C.    *           IAX = 7    THETA (THETA=0 => Z axis)                *
  25 C.    *    All values of IAX will be tried and then that value is     *
  26 C.    *    chosen, that results in the smallest number of volumes per *
  27 C.    *    division.                                                  *
  28 C.    *    Called by : GGCLOS                                         *
  29 C.    *    Author: Stephan Egli (large parts are copies of GGORD)     *
  30 C.    *                                                               *
  31 C.    *****************************************************************
  32 C.
  33 #include "geant321/gcbank.inc"
  34 #include "geant321/gcunit.inc"
  35 *
  36
  37       DIMENSION CLOW(500),CHIGH(500),CORD(1000),ITYPE(1000),
  38      +ICONT(500),ICON(1000),ICONS(500)
  39       EQUIVALENCE (CLOW(1),WS(1)),(CHIGH(1),WS(501))
  40       EQUIVALENCE (CORD(1),WS(1001)),(ITYPE(1),WS(2001))
  41       EQUIVALENCE (ICONT(1),WS(3001)),(ICON(1),WS(3501))
  42       EQUIVALENCE (ICONS(1),WS(4501))
  43 C
  44       CHARACTER*4 NAME
  45
  46 C.    ------------------------------------------------------------------
  47 *
  48       JVO = LQ(JVOLUM-IVO)
  49       CALL UHTOC(IQ(JVOLUM+IVO),4,NAME,4)
  50       NIN = Q(JVO+3)
  51       IAXNOW = 0
  52       IF(IQ(JVO-2).EQ.NIN+2) THEN
  53 *
  54 * *** This is to allow re-entry in the routine from the interactive
  55 * *** version.
  56          JNEAR = LQ(JVO-NIN-1)
  57          IF(JNEAR.GT.0) THEN
  58             JSB = LQ(JNEAR)
  59             IF(JSB.GT.0) THEN
  60                IAXNOW = Q(JSB+1)
  61             ENDIF
  62          ENDIF
  63       ENDIF
  64       IF(IAXNOW.EQ.0) THEN
  65          IAXNOW=-Q(JVO+1)
  66       ENDIF
  67 *   assume that ordering can not be done unless proven otherwise
  68       Q(JVO+1)=0.
  69       RBEST=1.E9
  70
  71 * try all possible axes
  72
  73       DO 1 IAX=1,7
  74
  75 *   count number of additional words needed and total number of volumes
  76 *   in all divisions
  77
  78       NCOALL=0
  79 *
  80 * *** Find the upper and lower coordinates of each content
  81 *
  82       DO 50 IN = 1,NIN
  83          CALL GFCLIM (JVO, IN, IAX, CLOW(IN), CHIGH(IN), IERR)
  84          IF (IERR.NE.0) GOTO 1
  85    50 CONTINUE
  86 *
  87 * *** Order the coordinate limits, keeping track of the associated
  88 *           content number
  89 *
  90       CALL GFCORD (NIN, CLOW, CHIGH, CORD, ITYPE, ICON)
  91       NC = NIN*2
  92 *
  93 *  **   Count and load up the distinct boundaries
  94 *
  95       IBO = 0
  96       DO 60 IC = 1,NC
  97          IBO = IBO +1
  98          IF (IBO.EQ.1) GO TO 60
  99          IF (CORD(IC)-CORD(IC-1).LT.1.E-4) IBO = IBO -1
 100    60 CONTINUE
 101       NDIV  = IBO -1
 102       IF (IAX.EQ.6) NDIV = IBO
 103
 104 *   *   Load up number of contents in each section
 105 *
 106       IDIV    = 0
 107       NCONT   = 1
 108       ICONT(1)= ICON(1)
 109       IF (IAX.NE.6) GO TO 70
 110       NCONT   = 0
 111       NSTOR   = 0
 112       ICONT(1)= 0
 113       DO 65 IN = 1,NIN
 114          IF (CHIGH(IN).GT.CLOW(IN)) GO TO 65
 115 *           (this content straddles PHI=0.)
 116          NSTOR = NSTOR +1
 117          ICONS(NSTOR) = IN
 118          IF (ICON(1).EQ.IN) GO TO 65
 119 *           (IN is in 1st division as well)
 120          NCONT = NCONT +1
 121          ICONT(NCONT) = IN
 122    65 CONTINUE
 123 *
 124       IF (ITYPE(1).EQ.2) GO TO 70
 125 *            (first boundary is a low, add the new content)
 126       NCONT = NCONT +1
 127       ICONT(NCONT) = ICON(1)
 128 *
 129    70 CONTINUE
 130 *
 131       DO 130 IC = 2,NC
 132          IDIV = IDIV +1
 133          IF (CORD(IC)-CORD(IC-1).LT.1.E-4) GO TO 90
 134 *
 135 *          New division, load up last division
 136 *
 137          IF (NCONT.LE.0) GO TO 100
 138          NCOALL=NCOALL+NCONT
 139          GO TO 100
 140    90    CONTINUE
 141          IDIV = IDIV -1
 142 *
 143   100    CONTINUE
 144 *
 145 *         Update contents of current division
 146 *
 147          IF (ITYPE(IC).EQ.1) GO TO 120
 148 *
 149 *         This boundary was a high, so one less content
 150 *
 151          ICP = 0
 152          DO 110 ICNT = 1,NCONT
 153             IF (ICONT(ICNT).EQ.ICON(IC)) ICP=1
 154          IF (ICP.EQ.1) ICONT(ICNT) = ICONT(ICNT+1)
 155   110    CONTINUE
 156          NCONT = NCONT -1
 157          GO TO 130
 158 *
 159   120    CONTINUE
 160 *
 161 *          This boundary was a low, so one extra content
 162 *
 163          NCONT = NCONT +1
 164          ICONT(NCONT) = ICON(IC)
 165 *
 166   130 CONTINUE
 167 *
 168       IF(IAX.EQ.6) NCOALL = NCOALL+NSTOR
 169       RNOW=FLOAT(NCOALL)/NDIV
 170       IF(RNOW.LT.RBEST)THEN
 171         IAXOPT=IAX
 172         RBEST=RNOW
 173         NDIVB=NDIV
 174       ENDIF
 175
 176 * end of loop over IAX
 177
 178 1     CONTINUE
 179
 180
 181 * now the best axis is selected - compare with axis requested by CALL
 182 * to GSORD (if any)
 183
 184       IF(IAXNOW.GT.0)THEN
 185
 186         WRITE (CHMAIL,1002) NAME,NIN,IAXOPT,NDIVB,RBEST,IAXNOW
 187         CALL  GMAIL (0, 0)
 188  1002   FORMAT(' GGORDQ : Volume ',A4,2X,'NIN=',I4,' IAX=',I2,2X,
 189      +    'NDIV=',I3,2X,'NVOL/DIV=',F5.1,2X,'IAX wanted by user:',I2)
 190
 191       ELSE
 192
 193         WRITE (CHMAIL,1003) NAME,NIN,IAXOPT,NDIVB,RBEST
 194         CALL  GMAIL (0, 0)
 195  1003   FORMAT(' GGORDQ : Volume ',A4,2X,'NIN=',I4,' IAX=',I2,2X,
 196      +    'NDIV=',I3,2X,'NVOL/DIV=',F5.1)
 197
 198       ENDIF
 199
 200 * overwrite old axis and store sorting information for new axis
 201
 202       Q(JVO+1)=-IAXOPT
 203       CALL GGORD(IVO)
 204
 205       END