GEANT321/cgpack/cgfvis.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:19:43  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.31  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE CGFVIS(NT,FACE,IVIS,ISHAPE)
  13 ************************************************************************
  14 *                                                                      *
  15 *     Name: CGFVIS                                                     *
  16 *     Authors: E. Chernyaev, S. Giani            Date:    01.08.89     *
  17 *                                                Revised:              *
  18 *                                                                      *
  19 *     Function: Transfer face to screen coordinates                    *
  20 *               and find face min-max and face visibility              *
  21 *                                                                      *
  22 *     References: none                                                 *
  23 *                                                                      *
  24 *     Input:  NT - number of transformation to screen coordinates      *
  25 *             FACE - face                                              *
  26 *                                                                      *
  27 *     Output: IVIS - visibility flag                                   *
  28 *                    1 - if visible face                               *
  29 *                   -1 - if unvisible                                  *
  30 *                                                                      *
  31 *     Errors: none                                                     *
  32 *                                                                      *
  33 ************************************************************************
  34 #include "geant321/cgcfac.inc"
  35 #include "geant321/cggpar.inc"
  36 #include "geant321/cgdelt.inc"
  37 #include "geant321/cgctra.inc"
  38 #include "geant321/gcspee.inc"
  39 ***SG
  40       DIMENSION ACCMI1(6),ACCMI2(6),ACCMI3(6),
  41      +          ACCMA1(6),ACCMA2(6),ACCMA3(6)
  42 ***SG
  43       REAL      FACE(*)
  44 #if !defined(CERNLIB_SINGLE)
  45       DOUBLE PRECISION  T(4,3),A,B,C,S
  46 #endif
  47 #if defined(CERNLIB_SINGLE)
  48       REAL      T(4,3)
  49 #endif
  50 *-
  51       IVIS   = -1
  52       DO 120 I=1,4
  53          DO 110 J=1,3
  54             T(I,J) = TSCRN(I,J,NT)
  55   110    CONTINUE
  56   120 CONTINUE
  57 *
  58 ***SG
  59 **         HIDDEN FACE REMOVAL
  60 *     Computing face scope and skipping if it's 'covered': this
  61 *     can allow a great increase in speed and a great reduction
  62 *     in number of memory words used.
  63 *
  64       IF(ISHAPE.LE.4.OR.ISHAPE.EQ.10)THEN
  65          NTIM=NTIM+1
  66          J = LCGFAC
  67          SRFMI1 = FACE(J+KCGX1)
  68          SRFMI2 = FACE(J+KCGY1)
  69          SRFMI3 = FACE(J+KCGZ1)
  70          SRFMA1 = FACE(J+KCGX1)
  71          SRFMA2 = FACE(J+KCGY1)
  72          SRFMA3 = FACE(J+KCGZ1)
  73          NEDGE = FACE(KCGNE)
  74          DO 333 NE=1,NEDGE
  75             SRFMI1 = MIN(SRFMI1,FACE(J+KCGX1),FACE(J+KCGX2))
  76             SRFMI2 = MIN(SRFMI2,FACE(J+KCGY1),FACE(J+KCGY2))
  77             SRFMI3 = MIN(SRFMI3,FACE(J+KCGZ1),FACE(J+KCGZ2))
  78             SRFMA1 = MAX(SRFMA1,FACE(J+KCGX1),FACE(J+KCGX2))
  79             SRFMA2 = MAX(SRFMA2,FACE(J+KCGY1),FACE(J+KCGY2))
  80             SRFMA3 = MAX(SRFMA3,FACE(J+KCGZ1),FACE(J+KCGZ2))
  81             J = J + LCGEDG
  82   333    CONTINUE
  83          IF(IPORLI.EQ.1)THEN
  84             ACCMI1(NTIM) = SRFMI1
  85             ACCMI2(NTIM) = SRFMI2
  86             ACCMI3(NTIM) = SRFMI3
  87             ACCMA1(NTIM) = SRFMA1
  88             ACCMA2(NTIM) = SRFMA2
  89             ACCMA3(NTIM) = SRFMA3
  90          ELSEIF(ISUBLI.EQ.1)THEN
  91             IF(NTIM.EQ.1.OR.NTIM.EQ.2)THEN
  92                IF(SRFMI3.LT.ACCMI3(NTIM).AND.SRFMA3
  93      +         .LT.ACCMA3(NTIM))GOTO 999
  94             ELSEIF(NTIM.EQ.3.OR.NTIM.EQ.5)THEN
  95                IF(SRFMI2.LT.ACCMI2(NTIM).AND.SRFMA2
  96      +         .LT.ACCMA2(NTIM))GOTO 999
  97             ELSEIF(NTIM.EQ.4.OR.NTIM.EQ.6)THEN
  98                IF(SRFMI1.LT.ACCMI1(NTIM).AND.SRFMA1
  99      +         .LT.ACCMA1(NTIM))GOTO 999
 100             ENDIF
 101          ENDIF
 102       ENDIF
 103 *
 104 ***SG
 105 *
 106       C      = (T(2,1)*T(3,2) - T(3,1)*T(2,2))*FACE(KCGAA) +
 107      +         (T(3,1)*T(1,2) - T(1,1)*T(3,2))*FACE(KCGBB) +
 108      +         (T(1,1)*T(2,2) - T(2,1)*T(1,2))*FACE(KCGCC)
 109       IF (C .LE. 0.)     GOTO 999
 110       B      = (T(2,3)*T(3,1) - T(3,3)*T(2,1))*FACE(KCGAA) +
 111      +         (T(3,3)*T(1,1) - T(1,3)*T(3,1))*FACE(KCGBB) +
 112      +         (T(1,3)*T(2,1) - T(2,3)*T(1,1))*FACE(KCGCC)
 113       A      = (T(2,2)*T(3,3) - T(3,2)*T(2,3))*FACE(KCGAA) +
 114      +         (T(3,2)*T(1,3) - T(1,2)*T(3,3))*FACE(KCGBB) +
 115      +         (T(1,2)*T(2,3) - T(2,2)*T(1,3))*FACE(KCGCC)
 116       S      = 1./SQRT(A*A+B*B+C*C)
 117       AABCD(1) = A*S
 118       AABCD(2) = B*S
 119       AABCD(3) = C*S
 120 *
 121       F1(KCGAF) = FACE(KCGAF)
 122       F1(KCGNE) = FACE(KCGNE)
 123       F1(KCGAA) = 0.
 124       F1(KCGBB) = 0.
 125       F1(KCGCC) = 1.
 126       F1(KCGDD) = 0.
 127       F1(KCGNE) = FACE(KCGNE)
 128 *
 129 **           T R A S F E R   P O I N T   C O O R D I N A T E S
 130 *
 131       NEDGE  = FACE(KCGNE)
 132       IF (LCGFAC+NEDGE*LCGEDG .GT. LABC)
 133      +       PRINT *, ' Problem in CGFVIS: no space'
 134       XGRAV  = 0.
 135       YGRAV  = 0.
 136       ZGRAV  = 0.
 137       J      = LCGFAC
 138       DO 200 NE=1,NEDGE
 139          F1(J+KCGAE) = FACE(J+KCGAE)
 140          X = FACE(J+KCGX1)
 141          Y = FACE(J+KCGY1)
 142          Z = FACE(J+KCGZ1)
 143          F1(J+KCGX1) = T(1,1)*X + T(2,1)*Y + T(3,1)*Z + T(4,1)
 144          F1(J+KCGY1) = T(1,2)*X + T(2,2)*Y + T(3,2)*Z + T(4,2)
 145          F1(J+KCGZ1) = T(1,3)*X + T(2,3)*Y + T(3,3)*Z + T(4,3)
 146          X = FACE(J+KCGX2)
 147          Y = FACE(J+KCGY2)
 148          Z = FACE(J+KCGZ2)
 149          F1(J+KCGX2) = T(1,1)*X + T(2,1)*Y + T(3,1)*Z + T(4,1)
 150          F1(J+KCGY2) = T(1,2)*X + T(2,2)*Y + T(3,2)*Z + T(4,2)
 151          F1(J+KCGZ2) = T(1,3)*X + T(2,3)*Y + T(3,3)*Z + T(4,3)
 152          XGRAV = XGRAV + F1(J+KCGX1) + F1(J+KCGX2)
 153          YGRAV = YGRAV + F1(J+KCGY1) + F1(J+KCGY2)
 154          ZGRAV = ZGRAV + F1(J+KCGZ1) + F1(J+KCGZ2)
 155          J = J + LCGEDG
 156   200 CONTINUE
 157       XFACT = 1./(2.*NEDGE)
 158       XGRAV = XGRAV * XFACT
 159       YGRAV = YGRAV * XFACT
 160       ZGRAV = ZGRAV * XFACT
 161       AABCD(4) =-(AABCD(1)*XGRAV + AABCD(2)*YGRAV + AABCD(3)*ZGRAV)
 162 *
 163 **           F I N D   F A C E   M I N - M A X
 164 *
 165       J      = LCGFAC
 166       RFMIN(1) = F1(J+KCGX1)
 167       RFMIN(2) = F1(J+KCGY1)
 168       RFMIN(3) = F1(J+KCGZ1)
 169       RFMAX(1) = F1(J+KCGX1)
 170       RFMAX(2) = F1(J+KCGY1)
 171       RFMAX(3) = F1(J+KCGZ1)
 172       DO 300 NE=1,NEDGE
 173          RFMIN(1) = MIN(RFMIN(1),F1(J+KCGX1),F1(J+KCGX2))
 174          RFMIN(2) = MIN(RFMIN(2),F1(J+KCGY1),F1(J+KCGY2))
 175          RFMIN(3) = MIN(RFMIN(3),F1(J+KCGZ1),F1(J+KCGZ2))
 176          RFMAX(1) = MAX(RFMAX(1),F1(J+KCGX1),F1(J+KCGX2))
 177          RFMAX(2) = MAX(RFMAX(2),F1(J+KCGY1),F1(J+KCGY2))
 178          RFMAX(3) = MAX(RFMAX(3),F1(J+KCGZ1),F1(J+KCGZ2))
 179          F1(J+KCGZ1) = 0.
 180          F1(J+KCGZ2) = 0.
 181          J = J + LCGEDG
 182   300 CONTINUE
 183       DRFACE(1) =-RFMAX(1)
 184       DRFACE(2) =-RFMAX(2)
 185       DRFACE(3) = RFMIN(1)
 186       DRFACE(4) = RFMIN(2)
 187       DRFACE(5) = RFMIN(3)
 188 *
 189 **          C O M P U T E    F A C E    V I S I B L E    A R E A
 190 *
 191       J      = LCGFAC
 192       S      = 0.
 193       DLMAX  = 0.
 194       DO 400 NE=1,NEDGE
 195          S = S + F1(J+KCGX1)*F1(J+KCGY2) - F1(J+KCGX2)*F1(J+KCGY1)
 196          DL = ABS(F1(J+KCGX2)-F1(J+KCGX1)) + ABS(F1(J+KCGY2)-F1(J+
 197      +   KCGY1))
 198          IF (DLMAX .LT. DL) DLMAX = DL
 199          J = J + LCGEDG
 200   400 CONTINUE
 201       IF (DLMAX .LT. EESCR)     GOTO 999
 202       IF (S .GT. DLMAX*EESCR)   IVIS = 1
 203 *
 204   999 RETURN
 205       END