]>
Commit | Line | Data |
---|---|---|
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 |