GEANT321/cgpack/cgbsea.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 CGBSEA(A,B,NB,JB)
  13 ************************************************************************
  14 *                                                                      *
  15 *     Name: CGBSEA                                                     *
  16 *     Author: E. Chernyaev                       Date:    22.10.88     *
  17 *                                                Revised:              *
  18 *                                                                      *
  19 *     Function: For face A search face with the same plane in object B *
  20 *                                                                      *
  21 *     References: none                                                 *
  22 *                                                                      *
  23 *     Input: A(*) - face                                               *
  24 *            B(*) - CG-object                                          *
  25 *     Input                                                            *
  26 *     Output: NB  - current face number in object B                    *
  27 *             JB  - current pointer in object B                        *
  28 *                                                                      *
  29 *     Errors: none                                                     *
  30 *                                                                      *
  31 ************************************************************************
  32 #include "geant321/cggpar.inc"
  33 #include "geant321/cgdelt.inc"
  34       REAL      A(*),B(*),ABCD(4)
  35 *-
  36       ABCD(1)= A(KCGAA)
  37       ABCD(2)= A(KCGBB)
  38       ABCD(3)= A(KCGCC)
  39       ABCD(4)= A(KCGDD)
  40       IF (NB .EQ. 0)            J = LCGHEA
  41       IF (NB .EQ. 0)            GOTO 100
  42       NEDGE  = B(JB+KCGNE)
  43       J      = JB + LCGFAC + NEDGE*LCGEDG
  44   100 NSTART = NB + 1
  45       NFACE  = B(KCGNF)
  46       IF (NSTART .GT. NFACE)    GOTO 998
  47       DO 120 NF=NSTART,NFACE
  48         IF (ABS(B(J+KCGAA)-ABCD(1)) .GT. EEWOR) GOTO 110
  49         IF (ABS(B(J+KCGBB)-ABCD(2)) .GT. EEWOR) GOTO 110
  50         IF (ABS(B(J+KCGCC)-ABCD(3)) .GT. EEWOR) GOTO 110
  51         IF (ABS(B(J+KCGDD)-ABCD(4)) .GT. EEWOR) GOTO 110
  52         NB     = NF
  53         JB     = J
  54         GOTO 999
  55   110   NEDGE  = B(J+KCGNE)
  56         J      = J + LCGFAC + NEDGE*LCGEDG
  57   120   CONTINUE
  58 *
  59   998 NB     = 0
  60   999 RETURN
  61       END