GEANT321/cgpack/cgslic.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:19:44  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.32  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE CGSLIC(A,SLIC,NMAX,B)
  13 ************************************************************************
  14 *                                                                      *
  15 *     Name: CGSLIC                                                     *
  16 *     Author: E. Chernyaev                       Date:    20.04.89     *
  17 *                                                Revised:              *
  18 *                                                                      *
  19 *     Function: Make slice of CG-object                                *
  20 *                                                                      *
  21 *     References: CGMNMX                                               *
  22 *                                                                      *
  23 *     Input:  A(*) - CG-object                                         *
  24 *          SLIC(4) - slicing plane                                     *
  25 *            NMAX  - max size of B-array                               *
  26 *                                                                      *
  27 *     Output:  B - resulting CG-object                                 *
  28 *                                                                      *
  29 *     Errors: none                                                     *
  30 *                                                                      *
  31 ************************************************************************
  32 #include "geant321/cggpar.inc"
  33 #include "geant321/cgdelt.inc"
  34       PARAMETER (NWORK=LCGHEA+6*(LCGFAC+4*LCGEDG))
  35       REAL      A(*),B(*),SLIC(4),ABCD(4)
  36       REAL      RMN(3),RMX(3),RMID(3),W(NWORK),XYZ(3,8)
  37 *-
  38       B(1)   = 0.
  39 *           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
  40       IF (NMAX .LT. LCGHEA)     GOTO 999
  41       S      = SQRT(SLIC(1)*SLIC(1)+SLIC(2)*SLIC(2)+SLIC(3)*SLIC(3))
  42       IF (S .LE. EEWOR)         GOTO 999
  43       ABCD(1)= SLIC(1) / S
  44       ABCD(2)= SLIC(2) / S
  45       ABCD(3)= SLIC(3) / S
  46       ABCD(4)= SLIC(4) / S
  47       CALL CGSCOP(1,A,RMN,RMX)
  48 *      CALL CGMNMX(A,RMN,RMX)
  49       IF (RMN(1) .GT. RMX(1))   GOTO 999
  50 *           M I N - M A X    T E S T
  51       NFACE  = A(KCGNF)
  52       IF (NFACE .EQ. 0)         GOTO 998
  53       NPOS   = 0
  54       NNEG   = 0
  55       J      = LCGHEA
  56       DO 120 NF=1,NFACE
  57         NEDGE  = A(J+KCGNE)
  58         J      = J + LCGFAC
  59         DO 110 NE=1,NEDGE
  60           DIST = ABCD(1)*A(J+KCGX1)+ABCD(2)*A(J+KCGY1)
  61      +          +ABCD(3)*A(J+KCGZ1) + ABCD(4)
  62           IF (DIST .GT.-EEWOR)    NPOS = NPOS + 1
  63           IF (DIST .LT.+EEWOR)    NNEG = NNEG + 1
  64           J      = J + LCGEDG
  65   110   CONTINUE
  66   120 CONTINUE
  67       IF (NPOS .EQ. 0)            GOTO 998
  68       IF (NNEG .EQ. 0)            CALL CGCOPY(A,NMAX,B)
  69       IF (NNEG .EQ. 0)            GOTO 999
  70 *           P R E P A R E   S L I C I N G   O B J E C T
  71       K      = 1
  72       IF (ABS(ABCD(2)) .GT. ABS(ABCD(1)))       K = 2
  73       IF (ABS(ABCD(3)) .GT. ABS(ABCD(K)))       K = 3
  74       RMID(1) = (RMN(1)+RMX(1)) / 2.
  75       RMID(2) = (RMN(2)+RMX(2)) / 2.
  76       RMID(3) = (RMN(3)+RMX(3)) / 2.
  77       RX      = RMX(1) - RMN(1)
  78       RY      = RMX(2) - RMN(2)
  79       RZ      = RMX(3) - RMN(3)
  80 *
  81       GOTO (210,220,230),K
  82   210 XYZ(2,1) = RMID(2) + RY
  83       XYZ(3,1) = RMID(3) + RZ
  84       XYZ(2,2) = RMID(2) - RY
  85       XYZ(3,2) = RMID(3) + RZ
  86       XYZ(2,3) = RMID(2) - RY
  87       XYZ(3,3) = RMID(3) - RZ
  88       XYZ(2,4) = RMID(2) + RY
  89       XYZ(3,4) = RMID(3) - RZ
  90       DO 215 I=1,4
  91         XYZ(1,I) = -(ABCD(2)*XYZ(2,I)+ABCD(3)*XYZ(3,I)+ABCD(4))/ABCD(1)
  92   215   CONTINUE
  93       GOTO 250
  94 *
  95   220 XYZ(1,1) = RMID(1) + RX
  96       XYZ(3,1) = RMID(3) + RZ
  97       XYZ(1,2) = RMID(1) - RX
  98       XYZ(3,2) = RMID(3) + RZ
  99       XYZ(1,3) = RMID(1) - RX
 100       XYZ(3,3) = RMID(3) - RZ
 101       XYZ(1,4) = RMID(1) + RX
 102       XYZ(3,4) = RMID(3) - RZ
 103       DO 225 I=1,4
 104         XYZ(2,I) = -(ABCD(1)*XYZ(1,I)+ABCD(3)*XYZ(3,I)+ABCD(4))/ABCD(2)
 105   225   CONTINUE
 106       GOTO 250
 107 *
 108   230 XYZ(1,1) = RMID(1) + RX
 109       XYZ(2,1) = RMID(2) + RY
 110       XYZ(1,2) = RMID(1) - RX
 111       XYZ(2,2) = RMID(2) + RY
 112       XYZ(1,3) = RMID(1) - RX
 113       XYZ(2,3) = RMID(2) - RY
 114       XYZ(1,4) = RMID(1) + RX
 115       XYZ(2,4) = RMID(2) - RY
 116       DO 235 I=1,4
 117         XYZ(3,I) = -(ABCD(1)*XYZ(1,I)+ABCD(2)*XYZ(2,I)+ABCD(4))/ABCD(3)
 118   235   CONTINUE
 119       GOTO 250
 120 *
 121   250 IF (ABCD(K) .GT. 0)     S = -3.
 122       IF (ABCD(K) .LT. 0)     S = +3.
 123       RX = 0.
 124       RY = 0.
 125       RZ = 0.
 126       IF (K .EQ. 1)           RX = S * (RMX(1)-RMN(1))
 127       IF (K .EQ. 2)           RY = S * (RMX(2)-RMN(2))
 128       IF (K .EQ. 3)           RZ = S * (RMX(3)-RMN(3))
 129       DO 255 I=1,4
 130         XYZ(1,I+4) = XYZ(1,I) + RX
 131         XYZ(2,I+4) = XYZ(2,I) + RY
 132         XYZ(3,I+4) = XYZ(3,I) + RZ
 133   255   CONTINUE
 134       CALL CGBOX(XYZ,4,4,NWORK,W)
 135       CALL CGCEV(1,W)
 136 *           M A K E   S L I C E
 137       CALL CGSUB(A,W,NMAX,B)
 138       GOTO 999
 139 *
 140   998 B(KCGSIZ) = LCGHEA
 141       B(KCGATT) = 0.
 142       B(KCGNF)  = 0.
 143   999 RETURN
 144       END