GEANT321/cgpack/cgbool.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 CGBOOL(IFA,IFB,A,B,NMAX,C)
  13 ************************************************************************
  14 *                                                                      *
  15 *     Name: CGBOOL                                                     *
  16 *     Author: E. Chernyaev                       Date:    05.04.89     *
  17 *                                                Revised:              *
  18 *                                                                      *
  19 *     Function: Make boolean operation with                            *
  20 *                                                                      *
  21 *     References: CGMNMX,CGCOPY,CGINVE,CGBSEA,CGBSEC,CGBINT,CGBSUB     *
  22 *                                                                      *
  23 *     Input: A(*) - 1-st CG-object                                     *
  24 *            B(*) - 2-nd CG-object                                     *
  25 *            NMAX - max length C array                                 *
  26 *                                                                      *
  27 *     Output: C(*) - resulting CG-object                               *
  28 *                                                                      *
  29 *     Errors: none                                                     *
  30 *                                                                      *
  31 ************************************************************************
  32 #include "geant321/cggpar.inc"
  33 #include "geant321/cgdelt.inc"
  34       REAL              A(*),B(*),C(*),AMN(3),AMX(3),BMN(3),BMX(3)
  35 *-
  36       C(KCGSIZ)   = 0.
  37 *           T E S T   P A R A M E T E R S   C O R R E C T N E S S
  38       CALL CGMNMX(A,AMN,AMX)
  39       CALL CGMNMX(B,BMN,BMX)
  40       IF (AMN(1) .GT. AMX(1))           GOTO 999
  41       IF (BMN(1) .GT. BMX(1))           GOTO 999
  42       IF (NMAX .LT. LCGHEA)             GOTO 998
  43       IF (A(KCGNF)  .EQ. 0.)            GOTO 110
  44       IF (B(KCGNF)  .EQ. 0.)            GOTO 120
  45       GOTO 150
  46 *           O B J E C T   "A"   I S   E M P T Y
  47   110 IF (IFA.NE.0 .AND. IFB.EQ.0)      GOTO 999
  48       IF (IFA .EQ. 0)                   CALL CGCOPY(B,NMAX,C)
  49       IF (IFB .NE. 0)                   CALL CGCOPY(A,NMAX,C)
  50       IF (C(KCGSIZ) .LT. 0.)            GOTO 998
  51       GOTO 999
  52 *           O B J E C T   "B"   I S   E M P T Y
  53   120 IF (IFB .EQ. 0)                   CALL CGCOPY(A,NMAX,C)
  54       IF (IFB .NE. 0)                   CALL CGCOPY(B,NMAX,C)
  55       IF (C(KCGSIZ) .LT. 0.)            GOTO 998
  56       GOTO 999
  57 *
  58 **          M I N - M A X   T E S T
  59 *
  60   150 DO 200 I=1,3
  61         IF (AMN(I) .GT. BMX(I)+EEWOR)   GOTO 210
  62         IF (AMX(I) .LT. BMN(I)-EEWOR)   GOTO 210
  63   200   CONTINUE
  64       GOTO 300
  65 *
  66 **          N O    I N T E R S E C T I O N   O F   S C O P E S
  67 *
  68   210 IF (IFA.NE.0 .AND. IFB.NE.0)      GOTO 220
  69 ****  12-MAR-1990
  70 *
  71 *      IF (IFA.NE.0 .AND. IFB.EQ.0)      GOTO 220
  72       IF (IFA.NE.0 .AND. IFB.EQ.0)      GOTO 230
  73 *
  74       IF (IFA.EQ.0 .AND. IFB.EQ.0)      GOTO 240
  75 *           N O   I N T E R S E C T I O N
  76   220 C(KCGSIZ) = LCGHEA
  77       C(KCGATT) = 0.
  78       C(KCGNF)  = 0.
  79       GOTO 999
  80 *           N O   S U B T R A C T I O N
  81   230 CALL CGCOPY(A,NMAX,C)
  82       IF (C(KCGSIZ) .LT. 0.)            GOTO 998
  83       GOTO 999
  84 *           S I M P L E   S U M   O F   O B J E C T S
  85   240 LTOTAL = A(KCGSIZ) + B(KCGSIZ) - LCGHEA
  86       IF (LTOTAL .GT. NMAX)             GOTO 998
  87       J      = A(KCGSIZ) - LCGHEA + 1
  88       CALL CGCOPY(B,NMAX,C(J))
  89       CALL CGCOPY(A,NMAX,C)
  90       C(KCGSIZ) = LTOTAL
  91       C(KCGNF)  = A(KCGNF) + B(KCGNF)
  92       GOTO 999
  93 *
  94 **          F I N D   I N T E R S E C T I O N   O F   F A C E S
  95 **          W I T H   T H E   S A M E   P L A N E
  96 *
  97   300 IF (IFA .NE. 0)           CALL CGINVE(A)
  98       IF (IFB .NE. 0)           CALL CGINVE(B)
  99       JA     = LCGHEA
 100       JC     = LCGHEA
 101       NC     = 0
 102       NFACE  = A(KCGNF)
 103       DO 330 NF=1,NFACE
 104         JB     = LCGHEA
 105         NB     = 0
 106   310   CALL CGBSEA(A(JA+1),B,NB,JB)
 107         IF (NB .EQ. 0)  GOTO 320
 108         CALL CGBINT(A(JA+1),B(JB+1),NMAX-JC,C(JC+1),IREP)
 109         IF (IREP .LT. 0)        GOTO 997
 110         IF (IREP .EQ. 0)        GOTO 310
 111         NC     = NC + 1
 112         JC     = JC + IREP
 113         GOTO 310
 114   320   NEDGE  = A(JA+KCGNE)
 115         JA     = JA + LCGFAC + NEDGE*LCGEDG
 116   330   CONTINUE
 117 *
 118 **          F I N D   P A R T   O F   1 - S T   O B J E C T   W H I C H
 119 **          L I E   O U T S I D E   O F   2 - N D   O B J E C T
 120 *
 121       J      = LCGHEA
 122       NFACE  = A(KCGNF)
 123       DO 400 NF=1,NFACE
 124         JCSAV  = JC
 125         CALL CGBSEC(A(J+1),B,BMN,BMX,NMAX-JCSAV,C(JCSAV+1),IREP)
 126         IF (IREP .LT. 0)        GOTO 997
 127         JC     = JCSAV + IREP
 128         CALL CGBSUB(IFB,A(J+1),C(JCSAV+1),NMAX-JC,C(JC+1),IREP)
 129         IF (IREP .LT. 0)        GOTO 997
 130         JC     = JCSAV + IREP
 131         IF (IREP .GT. 0)        NC = NC + 1
 132         NEDGE  = A(J+KCGNE)
 133         J      = J + LCGFAC + NEDGE*LCGEDG
 134   400   CONTINUE
 135 *
 136 **          F I N D   P A R T   O F   2 - N D   O B J E C T   W H I C H
 137 **          L I E   O U T S I D E   O F   1 - S T   O B J E C T
 138 *
 139       J      = LCGHEA
 140       NFACE  = B(KCGNF)
 141       DO 500 NF=1,NFACE
 142         JCSAV  = JC
 143         CALL CGBSEC(B(J+1),A,AMN,AMX,NMAX-JCSAV,C(JCSAV+1),IREP)
 144         IF (IREP .LT. 0)        GOTO 997
 145         JC     = JCSAV + IREP
 146         CALL CGBSUB(IFA,B(J+1),C(JCSAV+1),NMAX-JC,C(JC+1),IREP)
 147         IF (IREP .LT. 0)        GOTO 997
 148         JC     = JCSAV + IREP
 149         IF (IREP .GT. 0)        NC = NC + 1
 150         NEDGE  = B(J+KCGNE)
 151         J      = J + LCGFAC + NEDGE*LCGEDG
 152   500   CONTINUE
 153 *
 154       C(KCGSIZ) = JC
 155       C(KCGATT) = 0.
 156       C(KCGNF)  = NC
 157       IF (IFA.NE.0 .OR. IFB.NE.0)       CALL CGINVE(C)
 158 *
 159   997 IF (IFA .NE. 0)                   CALL CGINVE(A)
 160       IF (IFB .NE. 0)                   CALL CGINVE(B)
 161       IF (IREP .GE. 0)                  GOTO 999
 162   998 C(KCGSIZ) = -1.
 163   999 RETURN
 164       END