GEANT321/ggeom/ggord.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 GGORD (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 (static ordering only  -> GTMEDI)    *
  22 C.    *           IAX = 14   Rxy (also dynamic ordering -> GTNEXT)    *
  23 C.    *           IAX = 5    Rxyz (static ordering only -> GTMEDI)    *
  24 C.    *           IAX = 15   Rxyz (also dynamic ordering -> GTNEXT)   *
  25 C.    *           IAX = 6    PHI   (PHI=0 => X axis)                  *
  26 C.    *           IAX = 7    THETA (THETA=0 => Z axis)                *
  27 C.    *                                                               *
  28 C.    *    Called by : GGCLOS                                         *
  29 C.    *    Authors   : R.Brun, F.Bruyant, A.McPherson  *********      *
  30 C.    *                                                               *
  31 C.    *****************************************************************
  32 C.
  33 #include "geant321/gcbank.inc"
  34 #include "geant321/gcunit.inc"
  35       DIMENSION CLOW(500),CHIGH(500),CORD(1000),ITYPE(1000),
  36      +ICONT(500),ICON(1000),ICONS(500)
  37       DIMENSION P(100)
  38       EQUIVALENCE (CLOW(1),WS(1)),(CHIGH(1),WS(501))
  39       EQUIVALENCE (CORD(1),WS(1001)),(ITYPE(1),WS(2001))
  40       EQUIVALENCE (ICONT(1),WS(3001)),(ICON(1),WS(3501))
  41       EQUIVALENCE (ICONS(1),WS(4501)),(P(1),WS(5001))
  42 C.
  43 C.    ------------------------------------------------------------------
  44 *
  45       JVO = LQ(JVOLUM-IVO)
  46       NIN = Q(JVO+3)
  47       IAX = -Q(JVO+1)
  48 *
  49 * *** Inhibit dynamic ordering in Rxy and R unless explicitly required
  50 *     by user (ordering axis 14 or 15)
  51 *
  52       IF(IAX.EQ.4.OR.IAX.EQ.5)THEN
  53 *
  54 * *** Only static ordering allowed, dynamic inhibited (GNEXT,GTNEXT)
  55 *
  56          Q(JVO+1)=-1.
  57       ELSE
  58          Q(JVO+1)=-2.
  59       ENDIF
  60       IAX=MOD(IAX,10)
  61 *
  62 * *** Find the upper and lower coordinates of each content
  63 *
  64       DO 50 IN = 1,NIN
  65          CALL GFCLIM (JVO, IN, IAX, CLOW(IN), CHIGH(IN), IERR)
  66          IF (IERR.NE.0) THEN
  67             JIN = LQ(JVO-IN)
  68             IVOT  = Q(JIN+2)
  69             IROTT = Q(JIN+4)
  70             INUMT = Q(JIN+3)
  71             Q(JVO+1) = 0.
  72             WRITE (CHMAIL, 1001) IQ(JVOLUM+IVOT), INUMT, IQ(JVOLUM+IVO),
  73      +                           IAX, IROTT
  74             CALL GMAIL (0, 0)
  75             GO TO 999
  76          ENDIF
  77    50 CONTINUE
  78 *
  79 * *** Order the coordinate limits, keeping track of the associated
  80 *           content number
  81 *
  82       CALL GFCORD (NIN, CLOW, CHIGH, CORD, ITYPE, ICON)
  83 *
  84 * *** Book the JSB bank to store the boundaries
  85 *
  86       JNEAR = LQ(JVO-NIN-1)
  87       IF(LQ(JNEAR).EQ.0) THEN
  88          CALL MZBOOK (IXCONS,JSB,JNEAR,0,'VOBO',0,0,NIN*2+2,3,0)
  89          JVO = LQ(JVOLUM-IVO)
  90       ELSE
  91          JSB = LQ(JNEAR)
  92       ENDIF
  93       IQ(JSB-5) = IVO
  94 *
  95       Q(JSB+1) = IAX
  96       NC = NIN*2
  97 *
  98 *  **   Count and load up the distinct boundaries
  99 *
 100       IBO = 0
 101       DO 60 IC = 1,NC
 102          IBO = IBO +1
 103          Q(JSB+IBO+2) = CORD(IC)
 104          IF (IBO.EQ.1) GO TO 60
 105          IF (CORD(IC)-CORD(IC-1).LT.1.E-4) IBO = IBO -1
 106    60 CONTINUE
 107       Q(JSB+2) = IBO
 108       NDIV  = IBO -1
 109       IF (IAX.EQ.6) NDIV = IBO
 110 *
 111 *  **   Book the JSC0 bank to store the number of contents in each
 112 *        section (between neighbouring boundaries)
 113 *
 114       JSC0 = LQ(JVO-NIN-2)
 115       IF(JSC0.GT.0) THEN
 116          CALL MZDROP(IXCONS,JSC0,'L')
 117       ENDIF
 118       CALL MZBOOK (IXCONS,JSC0,JVO,-NIN-2,'VOBC',NDIV,NDIV,NDIV,2,0)
 119       IQ(JSC0-5) = IVO
 120 *
 121 *   *   Load up number of contents in each section and when greater
 122 *        than 0 book and load bank of contents
 123 *
 124       IDIV    = 0
 125       NCONT   = 1
 126       ICONT(1)= ICON(1)
 127       IF (IAX.NE.6) GO TO 70
 128       NCONT   = 0
 129       NSTOR   = 0
 130       ICONT(1)= 0
 131       DO 65 IN = 1,NIN
 132          IF (CHIGH(IN).GT.CLOW(IN)) GO TO 65
 133 *           (this content straddles PHI=0.)
 134          NSTOR = NSTOR +1
 135          ICONS(NSTOR) = IN
 136          IF (ICON(1).EQ.IN) GO TO 65
 137 *           (IN is in 1st division as well)
 138          NCONT = NCONT +1
 139          ICONT(NCONT) = IN
 140    65 CONTINUE
 141 *
 142       IF (ITYPE(1).EQ.2) GO TO 70
 143 *            (first boundary is a low, add the new content)
 144       NCONT = NCONT +1
 145       ICONT(NCONT) = ICON(1)
 146 *
 147    70 CONTINUE
 148 *
 149       DO 130 IC = 2,NC
 150          IDIV = IDIV +1
 151          IF (CORD(IC)-CORD(IC-1).LT.1.E-4) GO TO 90
 152 *
 153 *          New division, load up last division
 154 *
 155          IQ(JSC0+IDIV) = NCONT
 156          IF (NCONT.LE.0) GO TO 100
 157 *
 158 *          Book bank for contents
 159 *
 160          CALL MZBOOK (IXCONS,JSCV,JSC0,-IDIV,'VODC',0,0,NCONT,2,0)
 161          JVO = LQ(JVOLUM-IVO)
 162          JSC0= LQ(JVO-NIN-2)
 163 *
 164 *          Load up contents
 165 *
 166          DO 80 ICNT = 1,NCONT
 167             IQ(JSCV+ICNT) = ICONT(ICNT)
 168    80    CONTINUE
 169 *
 170          GO TO 100
 171    90    CONTINUE
 172          IDIV = IDIV -1
 173 *
 174   100    CONTINUE
 175 *
 176 *         Update contents of current division
 177 *
 178          IF (ITYPE(IC).EQ.1) GO TO 120
 179 *
 180 *         This boundary was a high, so one less content
 181 *
 182          ICP = 0
 183          DO 110 ICNT = 1,NCONT
 184             IF (ICONT(ICNT).EQ.ICON(IC)) ICP=1
 185          IF (ICP.EQ.1) ICONT(ICNT) = ICONT(ICNT+1)
 186   110    CONTINUE
 187          NCONT = NCONT -1
 188          GO TO 130
 189 *
 190   120    CONTINUE
 191 *
 192 *          This boundary was a low, so one extra content
 193 *
 194          NCONT = NCONT +1
 195          ICONT(NCONT) = ICON(IC)
 196 *
 197   130 CONTINUE
 198 *
 199       IF (IAX.NE.6) GO TO 150
 200       IQ(JSC0+NDIV) = NSTOR
 201       IF (NSTOR.EQ.0) GO TO 150
 202       CALL MZBOOK (IXCONS,JSCV,JSC0,-NDIV,'VOID',0,0,NSTOR,2,0)
 203 *
 204       DO 140 IS = 1,NSTOR
 205          IQ(JSCV+IS) = ICONS(IS)
 206   140 CONTINUE
 207       JVO  = LQ(JVOLUM-IVO)
 208       JSC0 = LQ(JVO-NIN-2)
 209   150 CONTINUE
 210       DO 159 I = 1,NDIV
 211          IF (IQ(JSC0+I).GT.1) GO TO 999
 212   159 CONTINUE
 213       IQ(JSC0) = IBSET(IQ(JSC0),0)
 214 *
 215  1001 FORMAT (' GGORD : Error in GFCLIM for content ',A4,I7,' in ',A4,
 216      +         ' along axis',I5,' IROT= ',I5)
 217 *                                                              END GGORD
 218   999 END
 219