GEANT321/cgpack/cgbsec.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 CGBSEC(FACE,CG,RMN,RMX,NMAX,C,IREP)
  13 ************************************************************************
  14 *                                                                      *
  15 *     Name: CGBTOP                                                     *
  16 *     Author: E. Chernyaev                       Date:    24.10.88     *
  17 *                                                Revised:              *
  18 *                                                                      *
  19 *     Function: Section of CG-object by face plane                     *
  20 *                                                                      *
  21 *     References: CGBTFP, CGBSOR                                       *
  22 *                                                                      *
  23 *     Input: FACE(*) - plane                                           *
  24 *            CG(*)   - CG-object                                       *
  25 *            RMN(3)  - min of CG-object scope                          *
  26 *            RMX(3)  - max of CG-object scope                          *
  27 *            NMAX    - max length of C array                           *
  28 *                                                                      *
  29 *     Output: C(*)   - resulting face                                  *
  30 *             IREP   - reply (length of resulitng face C)              *
  31 *                            (-1 if no space)                          *
  32 *                                                                      *
  33 *     Errors: none                                                     *
  34 *                                                                      *
  35 ************************************************************************
  36 #include "geant321/cggpar.inc"
  37 #include "geant321/cgdelt.inc"
  38       REAL      FACE(*),CG(*),RMN(3),RMX(3),C(*),D(8),ABCD(4)
  39 *-
  40       IF (NMAX .LT. LCGFAC)     GOTO 998
  41       IREP   = 0
  42       C(KCGAF) = NMAX
  43       C(KCGNE) = 0.
  44       ABCD(1)= FACE(KCGAA)
  45       ABCD(2)= FACE(KCGBB)
  46       ABCD(3)= FACE(KCGCC)
  47       ABCD(4)= FACE(KCGDD)
  48 *           M I N - M A X    T E S T
  49       D(1)   = ABCD(1)*RMN(1)+ABCD(2)*RMN(2)+ABCD(3)*RMN(3)+ABCD(4)
  50       D(2)   = ABCD(1)*RMX(1)+ABCD(2)*RMN(2)+ABCD(3)*RMN(3)+ABCD(4)
  51       D(3)   = ABCD(1)*RMN(1)+ABCD(2)*RMX(2)+ABCD(3)*RMN(3)+ABCD(4)
  52       D(4)   = ABCD(1)*RMX(1)+ABCD(2)*RMX(2)+ABCD(3)*RMN(3)+ABCD(4)
  53       D(5)   = ABCD(1)*RMN(1)+ABCD(2)*RMN(2)+ABCD(3)*RMX(3)+ABCD(4)
  54       D(6)   = ABCD(1)*RMX(1)+ABCD(2)*RMN(2)+ABCD(3)*RMX(3)+ABCD(4)
  55       D(7)   = ABCD(1)*RMN(1)+ABCD(2)*RMX(2)+ABCD(3)*RMX(3)+ABCD(4)
  56       D(8)   = ABCD(1)*RMX(1)+ABCD(2)*RMX(2)+ABCD(3)*RMX(3)+ABCD(4)
  57       NPOS   = 0
  58       NNEG   = 0
  59       DO 100 I=1,8
  60         IF (D(I) .GT. EEWOR)    NPOS = NPOS + 1
  61         IF (D(I) .LT.-EEWOR)    NNEG = NNEG + 1
  62   100   CONTINUE
  63       IF (NPOS.EQ.8 .OR. NNEG.EQ.8)     GOTO 999
  64 *
  65       NFACE  = CG(KCGNF)
  66       JCG    = LCGHEA
  67       DO 200 NF=1,NFACE
  68         CALL CGBTFP(CG(JCG+1),ABCD,C)
  69         IF (C(KCGAF) .LT. 0.)   GOTO 998
  70         NEDGE  = CG(JCG+KCGNE)
  71         JCG    = JCG + LCGFAC + NEDGE*LCGEDG
  72   200   CONTINUE
  73 *
  74 **          S O R T   E G E S  &  D E L E T E   D O U B L E   E D G E S
  75 *
  76       NEDGE  = C(KCGNE)
  77       CALL CGBSOR(NEDGE,C(LCGFAC+1))
  78       C(KCGNE) = NEDGE
  79       IF (NEDGE .EQ. 0)         GOTO 997
  80 *      IF (NEDGE .LT. 3) PRINT *,' CGBSEC: NEDGE .LT. 3 - face ignored'
  81       IF (NEDGE .LT. 3)         GOTO 997
  82       C(KCGAA) = ABCD(1)
  83       C(KCGBB) = ABCD(2)
  84       C(KCGCC) = ABCD(3)
  85       C(KCGDD) = ABCD(4)
  86       J      = LCGFAC
  87       DO 300 NE=1,NEDGE
  88         C(J+KCGAE) = C(J+KCGAE) - 2.
  89         J    = J + LCGEDG
  90   300   CONTINUE
  91       IREP   = LCGFAC + LCGEDG*NEDGE
  92       GOTO 999
  93 *
  94   997 IREP   = 0
  95       GOTO 999
  96   998 IREP   =-1
  97   999 RETURN
  98       END