| fe4da5cc |
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 CGBSUB(IFB,A,B,NMAX,C,IREP) |
| 13 | ************************************************************************ |
| 14 | * * |
| 15 | * Name: CGBSUB * |
| 16 | * Author: E. Chernyaev Date: 23.10.88 * |
| 17 | * Revised: * |
| 18 | * * |
| 19 | * Function: Subtraction of two faces * |
| 20 | * * |
| 21 | * References: CGBMMT,CGBTEF,CGBSOR * |
| 22 | * * |
| 23 | * Input: IFB - flag (=1, if -B) |
| 24 | * A(*) - 1-st face * |
| 25 | * B(*) - 2-nd face * |
| 26 | * NMAX - max length C array * |
| 27 | * * |
| 28 | * Output: B(*) - resulting face * |
| 29 | * C(*) - working face * |
| 30 | * IREP - reply (legth of resulting face) * |
| 31 | * (-1 if no space) * |
| 32 | * Errors: none * |
| 33 | * * |
| 34 | ************************************************************************ |
| 35 | #include "geant321/cggpar.inc" |
| 36 | REAL A(*),B(*),C(*) |
| 37 | DATA IEXTNL/1/,IINTNL/-1/ |
| 38 | *- |
| 39 | NAEDGE = A(KCGNE) |
| 40 | NBEDGE = B(KCGNE) |
| 41 | IF (NBEDGE .EQ. 0) GOTO 100 |
| 42 | * M I N - M A X T E S T |
| 43 | CALL CGBMMT(A,B,IREP) |
| 44 | IF (IREP .NE. 0) GOTO 200 |
| 45 | * |
| 46 | ** N O I N T E R S E C T I O N O F F A C E S |
| 47 | * |
| 48 | 100 IF (IFB .NE. 0) GOTO 997 |
| 49 | LENB = LCGFAC + NBEDGE*LCGEDG |
| 50 | IREP = LCGFAC + NAEDGE*LCGEDG |
| 51 | IF (IREP .GT. NMAX+LENB) GOTO 998 |
| 52 | DO 110 I=1,IREP |
| 53 | B(I) = A(I) |
| 54 | 110 CONTINUE |
| 55 | GOTO 999 |
| 56 | * |
| 57 | ** T E S T 1 - S T F A C E A G A I N S T 2 - N D |
| 58 | * |
| 59 | 200 IF (NMAX .LT. LCGFAC) GOTO 998 |
| 60 | C(KCGAF) = NMAX |
| 61 | C(KCGNE) = 0. |
| 62 | IF (IFB .EQ. 0) IFLAG = IEXTNL |
| 63 | IF (IFB .NE. 0) IFLAG = IINTNL |
| 64 | IVAR = 1 |
| 65 | J = LCGFAC |
| 66 | DO 210 NE=1,NAEDGE |
| 67 | CALL CGBTEF(IFLAG,IVAR,A(J+1),B,C) |
| 68 | IF (C(KCGAF) .LT. 0.) GOTO 998 |
| 69 | J = J + LCGEDG |
| 70 | 210 CONTINUE |
| 71 | * |
| 72 | ** T E S T 2 - N D F A C E A G A I N S T 1 - S T |
| 73 | * |
| 74 | J = LCGFAC |
| 75 | DO 300 NE=1,NBEDGE |
| 76 | CALL CGBTEF(IINTNL,IVAR,B(J+1),A,C) |
| 77 | IF (C(KCGAF) .LT. 0.) GOTO 998 |
| 78 | J = J + LCGEDG |
| 79 | 300 CONTINUE |
| 80 | * P R E P A R E N E W F A C E |
| 81 | NEDGE = C(KCGNE) |
| 82 | IF (NEDGE .EQ. 0) GOTO 997 |
| 83 | CALL CGBSOR(NEDGE,C(LCGFAC+1)) |
| 84 | C(KCGNE) = NEDGE |
| 85 | IF (NEDGE .EQ. 0) GOTO 997 |
| 86 | * IF (NEDGE .LT. 3) PRINT *,' CGBSUB: NEDGE .LT. 3 - face ignored' |
| 87 | C(KCGAF) = A(KCGAF) |
| 88 | C(KCGAA) = A(KCGAA) |
| 89 | C(KCGBB) = A(KCGBB) |
| 90 | C(KCGCC) = A(KCGCC) |
| 91 | C(KCGDD) = A(KCGDD) |
| 92 | IREP = LCGFAC + NEDGE*LCGEDG |
| 93 | DO 400 I=1,IREP |
| 94 | B(I) = C(I) |
| 95 | 400 CONTINUE |
| 96 | GOTO 999 |
| 97 | * |
| 98 | 997 IREP = 0 |
| 99 | GOTO 999 |
| 100 | 998 IREP = -1 |
| 101 | 999 RETURN |
| 102 | END |
| 103 | |
git://git.uio.no / u / mrichter / AliRoot.git / blame