GEANT321/cgpack/cgbtef.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:19:42  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 CGBTEF(IFEXT,IVAR,EDGE,FACE,C)
  13 ************************************************************************
  14 *                                                                      *
  15 *     Name: CGBTEF                                                     *
  16 *     Author: E. Chernyaev                       Date:    23.10.88     *
  17 *                                                Revised:              *
  18 *                                                                      *
  19 *     Function: Test edge against face                                 *
  20 *                                                                      *
  21 *     References: CGBEDG, CGTSOR                                       *
  22 *                                                                      *
  23 *     Input: IFEXT - flag for searching external or internal intervals *
  24 *                    ( 1 - external, -1 - internal)                    *
  25 *             IVAR - number of variant                                 *
  26 *                    ( 1 - visibility of intervals the same as edge)   *
  27 *                    ( 2 - intervals are invisible)                    *
  28 *          EDGE(*) - number of edges in face                           *
  29 *        FACE(*,*) - face                                              *
  30 *             NMAX - max length of C array                             *
  31 *                                                                      *
  32 *     Output: C(*) - a set of new edges                                *
  33 *                    (C(KCGAF) = -1 if no space)                       *
  34 *                                                                      *
  35 *     Errors: none                                                     *
  36 *                                                                      *
  37 ************************************************************************
  38 #include "geant321/cggpar.inc"
  39 #include "geant321/cgcedg.inc"
  40       CHARACTER*2 WHAT
  41       REAL      EDGE(LCGEDG),FACE(*),C(*),ABCD(4)
  42       INTEGER   KCG(6)
  43       DATA      KCG/KCGX1,KCGY1,KCGZ1,KCGX2,KCGY2,KCGZ2/
  44 *-
  45 **          F I N D   I N T E R S E C T I O N   P O I N T S
  46 *
  47       IF (IFEXT .LE. 0)         WHAT = 'LE'
  48       IF (IFEXT .GT. 0)         WHAT = 'GE'
  49       XD     = EDGE(KCGX2) - EDGE(KCGX1)
  50       YD     = EDGE(KCGY2) - EDGE(KCGY1)
  51       ZD     = EDGE(KCGZ2) - EDGE(KCGZ1)
  52       ALENG  = SQRT(XD*XD + YD*YD + ZD*ZD)
  53       IF(ALENG.LT.1.0E-4)GOTO 998
  54       XD     = XD / ALENG
  55       YD     = YD / ALENG
  56       ZD     = ZD / ALENG
  57       ABCD(1)= YD*FACE(KCGCC) - FACE(KCGBB)*ZD
  58       ABCD(2)= ZD*FACE(KCGAA) - FACE(KCGCC)*XD
  59       ABCD(3)= XD*FACE(KCGBB) - FACE(KCGAA)*YD
  60       ABCD(4)=-(ABCD(1)*EDGE(KCGX1) +
  61      +          ABCD(2)*EDGE(KCGY1) +
  62      +          ABCD(3)*EDGE(KCGZ1))
  63       CALL CGBFIT(FACE,ABCD,NT)
  64       IF (NT .GT. 0)                    GOTO 100
  65       XA     = EDGE(KCGX1)
  66       YA     = EDGE(KCGY1)
  67       ZA     = EDGE(KCGZ1)
  68       XDELT  = EDGE(KCGX2) - EDGE(KCGX1)
  69       YDELT  = EDGE(KCGY2) - EDGE(KCGY1)
  70       ZDELT  = EDGE(KCGZ2) - EDGE(KCGZ1)
  71 *
  72 **          P R E P A R E   E D G E S
  73 *
  74   100 K      = 1
  75       IF (ABS(YDELT) .GT. ABS(XDELT))   K = 2
  76       IF (ABS(ZDELT) .GT. ABS(DELTA(K))) K = 3
  77       TMIN   = (EDGE(KCG(K))    - AA(K)) / DELTA(K)
  78       TMAX   = (EDGE(KCG(K+3))  - AA(K)) / DELTA(K)
  79       CALL CGBTTT(WHAT,TMIN,TMAX,NT,NEDGE)
  80       IF (NEDGE .EQ. 0)                 GOTO 999
  81       IVIS   = EDGE(KCGAE)
  82       NMAX   = C(KCGAF)
  83       NN     = C(KCGNE)
  84       J      = LCGFAC + NN*LCGEDG
  85       IF (NMAX .LT. J + NEDGE*LCGEDG)   GOTO 998
  86       DO 500 NE=1,NEDGE
  87         IF (IVAR .EQ. 1)                C(J+KCGAE) = IVIS
  88         IF (IVAR .EQ. 2)                C(J+KCGAE) =-1.
  89         IF (ITTT(NE) .NE. 0)            C(J+KCGAE) = IVIS
  90         C(J+KCGX1) = XA + XDELT*TTT(1,NE)
  91         C(J+KCGY1) = YA + YDELT*TTT(1,NE)
  92         C(J+KCGZ1) = ZA + ZDELT*TTT(1,NE)
  93         C(J+KCGX2) = XA + XDELT*TTT(2,NE)
  94         C(J+KCGY2) = YA + YDELT*TTT(2,NE)
  95         C(J+KCGZ2) = ZA + ZDELT*TTT(2,NE)
  96         J      = J + LCGEDG
  97   500   CONTINUE
  98       C(KCGNE) = C(KCGNE) + NEDGE
  99       GOTO 999
 100 *
 101   998 C(KCGAF) =-1.
 102   999 RETURN
 103       END