GEANT321/ggeom/gntrap.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:54  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.30  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GNTRAP (X, PAR, IACT, IFLAG, SNEXT, SNXT, SAFE)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *      COMPUTE DISTANCE UP TO INTERSECTION WITH 'TRD1' OR 'TRD2' *
  17 C.    *      VOLUME, FROM INSIDE POINT X(1-3) ALONG DIRECTION X(4-6)   *
  18 C.    *                                                                *
  19 C.    *       PAR   (input)  : volume parameters                       *
  20 C.    *       IACT  (input)  : action flag                             *
  21 C.    *         = 0  Compute SAFE only                                 *
  22 C.    *         = 1  Compute SAFE, and SNXT only if SNEXT .GT.new SAFE *
  23 C.    *         = 2  Compute both SAFE and SNXT                        *
  24 C.    *         = 3  Compute SNXT only                                 *
  25 C.    *       IFLAG (input)  : 1 for TRD1, 2 for TRD2                  *
  26 C.    *       SNEXT (input)  : see IACT = 1                            *
  27 C.    *       SNXT  (output) : distance to volume boundary             *
  28 C.    *       SAFE  (output) : shortest distance to any boundary       *
  29 C.    *                                                                *
  30 C.    *    ==>Called by : GNEXT, GTNEXT                                *
  31 C.    *         Author  A.McPherson,  P.Weidhaas  *********            *
  32 C.    *                                                                *
  33 C.    ******************************************************************
  34 C.
  35 #include "geant321/gconsp.inc"
  36       DIMENSION X(6),PAR(5)
  37 C.
  38 C.    ------------------------------------------------------------------
  39 C.
  40       SNXT = BIG
  41       IF (IFLAG .EQ. 1) THEN
  42         FACTX  = (PAR(2) - PAR(1)) / (2.0 * PAR(4))
  43       ELSEIF (IFLAG .EQ. 2) THEN
  44         FACTX  = (PAR(2) - PAR(1)) / (2.0 * PAR(5))
  45         FACTY  = (PAR(4) - PAR(3)) / (2.0 * PAR(5))
  46       ENDIF
  47
  48       IF (IACT .LT. 3) THEN
  49
  50 C       -------------------------------------------------
  51 C       |  Compute safety-distance 'SAFE' (P.Weidhaas)  |
  52 C       -------------------------------------------------
  53
  54         IF (IFLAG .EQ. 1) THEN
  55 C*******************************************************
  56 C
  57 C......  Shape "TRD1":   only x varies with z.
  58 C
  59 C*******************************************************
  60
  61           SAF2  = PAR(3) - ABS(X(2))
  62           SAF3  = PAR(4) - ABS(X(3))
  63 C
  64 C......  Distance alng x-direction to slanted wall.
  65 C
  66           DISTX = PAR(1) + FACTX * (PAR(4) + X(3)) - ABS(X(1))
  67           SAF1  = DISTX / SQRT (1.0 + FACTX*FACTX)
  68         ELSE
  69 C*******************************************************
  70 C
  71 C......  Shape "TRD2":   both x and y vary with z.
  72 C
  73 C*******************************************************
  74           SAF3  = PAR(5) - ABS(X(3))
  75 C
  76 C......  Distance along x-direction to slanted wall.
  77 C
  78           DISTX = PAR(1) + FACTX * (PAR(5) + X(3)) - ABS(X(1))
  79           SAF1  = DISTX / SQRT (1.0 + FACTX*FACTX)
  80 C
  81 C......  Distance along y-direction to slanted wall.
  82 C
  83           DISTY = PAR(3) + FACTY * (PAR(5) + X(3)) - ABS(X(2))
  84           SAF2  = DISTY / SQRT (1.0 + FACTY*FACTY)
  85         ENDIF
  86
  87         SAFE  = MIN (SAF1, SAF2, SAF3)
  88
  89         IF (IACT .EQ. 0) GO TO 999
  90         IF (IACT .EQ. 1) THEN
  91           IF (SNEXT .LT. SAFE) GO TO 999
  92         ENDIF
  93       ENDIF
  94
  95
  96 C     ------------------------------------------------
  97 C     |  Compute vector-distance 'SNXT' (McPherson)  |
  98 C     ------------------------------------------------
  99
 100
 101       IF(IFLAG.NE.1) GO TO 20
 102 C
 103 C              Only x-thickness varies with z.
 104 C
 105 C
 106 C              First check z.
 107 C
 108       ZEND=PAR(4)
 109       IF(X(6).LT.0.0) ZEND=-ZEND
 110       IF(X(6).EQ.0.)GO TO 5
 111       SNXT=(ZEND-X(3))/X(6)
 112 C
 113 C              Now do Y.
 114 C
 115    5  YEND=PAR(3)
 116       IF(X(5).LT.0.0) YEND=-YEND
 117       IF(X(5).EQ.0.)GO TO 7
 118       SN=(YEND-X(2))/X(5)
 119       IF(SN.LT.SNXT) SNXT=SN
 120 C
 121 C              Now do X.
 122 C
 123    7  DXM=0.5*(PAR(1)+PAR(2))
 124       ANUM=DXM+FACTX*X(3)-X(1)
 125       DENO=X(4)-FACTX*X(6)
 126 C
 127       IF(DENO.EQ.0.0) GO TO 10
 128       QUOT = ANUM/DENO
 129       IF(QUOT.LE.0.0.OR.QUOT.GT.SNXT) GO TO 10
 130       SNXT=QUOT
 131       GO TO 999
 132 C
 133    10 CONTINUE
 134 C
 135       ANUM=-FACTX*X(3)-X(1)-DXM
 136       DENO=FACTX*X(6)+X(4)
 137 C
 138       IF(DENO.EQ.0.0) GO TO 999
 139       QUOT = ANUM/DENO
 140       IF(QUOT.GT.0.0.AND.QUOT.LT.SNXT) SNXT=QUOT
 141 C
 142       GO TO 999
 143    20 CONTINUE
 144 C
 145 C              x- and y-thicknesses vary with z.
 146 C
 147 C
 148 C              First check z
 149 C
 150       ZEND=PAR(5)
 151       IF(X(6).LT.0.0) ZEND=-ZEND
 152       IF(X(6).EQ.0.)GO TO 25
 153       SNXT=(ZEND-X(3))/X(6)
 154 C
 155 C              Now do x.
 156 C
 157   25  DXM=0.5*(PAR(1)+PAR(2))
 158       ANUM=DXM+FACTX*X(3)-X(1)
 159       DENO=X(4)-FACTX*X(6)
 160 C
 161       IF(DENO.EQ.0.0) GO TO 40
 162       QUOT = ANUM/DENO
 163       IF(QUOT.LE.0.0.OR.QUOT.GT.SNXT) GO TO 40
 164       SNXT=QUOT
 165       GO TO 60
 166 C
 167    40 CONTINUE
 168 C
 169       ANUM=-FACTX*X(3)-X(1)-DXM
 170       DENO=FACTX*X(6)+X(4)
 171 C
 172       IF(DENO.EQ.0.0) GO TO 60
 173       QUOT = ANUM/DENO
 174       IF(QUOT.GT.0.0.AND.QUOT.LT.SNXT) SNXT=QUOT
 175 C
 176    60 CONTINUE
 177 C
 178 C             Now do y.
 179 C
 180       DYM=0.5*(PAR(3)+PAR(4))
 181       ANUM=DYM+FACTY*X(3)-X(2)
 182       DENO=X(5)-FACTY*X(6)
 183 C
 184       IF(DENO.EQ.0.0) GO TO 80
 185       QUOT = ANUM/DENO
 186       IF(QUOT.LE.0.0.OR.QUOT.GT.SNXT) GO TO 80
 187       SNXT=QUOT
 188       GO TO 999
 189 C
 190    80 CONTINUE
 191 C
 192       ANUM=-FACTY*X(3)-X(2)-DYM
 193       DENO=FACTY*X(6)+X(5)
 194 C
 195       IF(DENO.EQ.0.0) GO TO 999
 196       QUOT = ANUM/DENO
 197       IF(QUOT.GT.0.0.AND.QUOT.LT.SNXT) SNXT=QUOT
 198 C
 199   999 CONTINUE
 200       END