GEANT321/cgpack/cgbox.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 CGBOX (XYZ,N1,N2,LCG,CG)
  13 ************************************************************************
  14 *                                                                      *
  15 *     Name: CGBOX                                                      *
  16 *     Author: E. Chernyaev                       Date:    12.02.89     *
  17 *                                                Revised:              *
  18 *                                                                      *
  19 *     Function: Create CG-object for box                               *
  20 *                                                                      *
  21 *     References: CGSIZE, CGSNOR                                       *
  22 *                                                                      *
  23 *     Input: XYZ(3,N1+N2) - nodes                                      *
  24 *                N1 - number of nodes in main base                     *
  25 *                N2 - number of nodes in 2-nd base                     *
  26 *               LCG - max-size of CG-object                            *
  27 *                                                                      *
  28 *     Output: CG - CG-object                                           *
  29 *                  CG(1) - length of CG-object                         *
  30 *                        = 0 if error in parameters                    *
  31 *                        < 0 if no space                               *
  32 *                                                                      *
  33 *     Errors: none                                                     *
  34 *                                                                      *
  35 ************************************************************************
  36 #include "geant321/cggpar.inc"
  37       REAL      CG(*),XYZ(3,*)
  38       INTEGER   NFAC(2),NEDG(2)
  39 *-
  40       CG(KCGSIZ)  = 0.
  41 *           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
  42       IF (N1 .LT. 3)                    GOTO 999
  43       IF (N2.NE.N1 .AND. N2.NE.1)       GOTO 999
  44 *           C O M P U T E   S I Z E   O F   C G - O B J E C T
  45       NFATYP = 2
  46       NEDG(1)= N1
  47       IF (N2 .NE. 1)                    NEDG(2) = 4
  48       IF (N2 .EQ. 1)                    NEDG(2) = 3
  49       IF (N2 .NE. 1)                    NFAC(1) = 2
  50       IF (N2 .EQ. 1)                    NFAC(1) = 1
  51       NFAC(2)= N1
  52       CG(KCGSIZ)  = CGSIZE(LCG,NFATYP,NFAC,NEDG)
  53       IF (CG(KCGSIZ) .LE. 0.)        GOTO 999
  54 *
  55 **          C R E A T E   C G - O B J E C T
  56 *
  57       CG(KCGATT) = 0.
  58       CG(KCGNF)  = NFAC(1) + NFAC(2)
  59       JCG        = LCGHEA
  60 *           C R E A T E   M A I N   B A S E
  61       CG(JCG + KCGAF) = 0.
  62       CG(JCG + KCGNE) = N1
  63       JCG    = JCG + LCGFAC
  64       DO 100 I=1,N1
  65         I1     = I
  66         I2     = I + 1
  67         IF (I .EQ. N1)          I2 = 1
  68         CG(JCG+KCGAE) = 0.
  69         CG(JCG+KCGX1) = XYZ(1,I1)
  70         CG(JCG+KCGY1) = XYZ(2,I1)
  71         CG(JCG+KCGZ1) = XYZ(3,I1)
  72         CG(JCG+KCGX2) = XYZ(1,I2)
  73         CG(JCG+KCGY2) = XYZ(2,I2)
  74         CG(JCG+KCGZ2) = XYZ(3,I2)
  75         JCG    = JCG + LCGEDG
  76   100   CONTINUE
  77 *           C R E A T E   2 - N D   B A S E
  78       IF (N2 .EQ. 1)            GOTO 300
  79       CG(JCG + KCGAF) = 0.
  80       CG(JCG + KCGNE) = N2
  81       JCG    = JCG + LCGFAC
  82       DO 200 I=1,N2
  83         I1     = I
  84         I2     = I + 1
  85         IF (I .EQ. N2)          I2 = 1
  86         CG(JCG+KCGAE) = 0.
  87         CG(JCG+KCGX1) = XYZ(1,I2+N1)
  88         CG(JCG+KCGY1) = XYZ(2,I2+N1)
  89         CG(JCG+KCGZ1) = XYZ(3,I2+N1)
  90         CG(JCG+KCGX2) = XYZ(1,I1+N1)
  91         CG(JCG+KCGY2) = XYZ(2,I1+N1)
  92         CG(JCG+KCGZ2) = XYZ(3,I1+N1)
  93         JCG    = JCG + LCGEDG
  94   200   CONTINUE
  95 *           C R E A T E   S I D E   F A C E S
  96   300 DO 350 I=1,N1
  97         I1     = I
  98         I2     = I + 1
  99         IF (I .EQ. N1)          I2 = 1
 100         CG(JCG + KCGAF) = 0.
 101         CG(JCG + KCGNE) = NEDG(2)
 102         JCG    = JCG + LCGFAC
 103 *
 104         CG(JCG+KCGAE) = 0.
 105         CG(JCG+KCGX1) = XYZ(1,I2)
 106         CG(JCG+KCGY1) = XYZ(2,I2)
 107         CG(JCG+KCGZ1) = XYZ(3,I2)
 108         CG(JCG+KCGX2) = XYZ(1,I1)
 109         CG(JCG+KCGY2) = XYZ(2,I1)
 110         CG(JCG+KCGZ2) = XYZ(3,I1)
 111         JCG    = JCG + LCGEDG
 112 *
 113         IF (N2 .NE. 1)          K = N1 + I1
 114         IF (N2 .EQ. 1)          K = N1 + 1
 115         CG(JCG+KCGAE) = 0.
 116         CG(JCG+KCGX1) = XYZ(1,I1)
 117         CG(JCG+KCGY1) = XYZ(2,I1)
 118         CG(JCG+KCGZ1) = XYZ(3,I1)
 119         CG(JCG+KCGX2) = XYZ(1,K)
 120         CG(JCG+KCGY2) = XYZ(2,K)
 121         CG(JCG+KCGZ2) = XYZ(3,K)
 122         JCG    = JCG + LCGEDG
 123 *
 124         IF (N2 .EQ. 1)          GOTO 310
 125         CG(JCG+KCGAE) = 0.
 126         CG(JCG+KCGX1) = XYZ(1,I1+N1)
 127         CG(JCG+KCGY1) = XYZ(2,I1+N1)
 128         CG(JCG+KCGZ1) = XYZ(3,I1+N1)
 129         CG(JCG+KCGX2) = XYZ(1,I2+N1)
 130         CG(JCG+KCGY2) = XYZ(2,I2+N1)
 131         CG(JCG+KCGZ2) = XYZ(3,I2+N1)
 132         JCG    = JCG + LCGEDG
 133 *
 134   310   IF (N2 .NE. 1)          K = N1 + I2
 135         IF (N2 .EQ. 1)          K = N1 + 1
 136         CG(JCG+KCGAE) = 0.
 137         CG(JCG+KCGX1) = XYZ(1,K)
 138         CG(JCG+KCGY1) = XYZ(2,K)
 139         CG(JCG+KCGZ1) = XYZ(3,K)
 140         CG(JCG+KCGX2) = XYZ(1,I2)
 141         CG(JCG+KCGY2) = XYZ(2,I2)
 142         CG(JCG+KCGZ2) = XYZ(3,I2)
 143         JCG    = JCG + LCGEDG
 144   350   CONTINUE
 145 *           S E T   N O R M A L E S
 146       CALL CGSNOR(CG)
 147       IF (CG(1) .EQ. 0.) PRINT *, ' Problem in CGBOX'
 148       JCG    = LCGHEA
 149       A      = CG(JCG + KCGAA)
 150       B      = CG(JCG + KCGBB)
 151       C      = CG(JCG + KCGCC)
 152       D      = CG(JCG + KCGDD)
 153       DIST   = A*XYZ(1,N1+1) + B*XYZ(2,N1+1) + C*XYZ(3,N1+1) + D
 154       IF (DIST .LT. 0.)         GOTO 999
 155 *           S E T   I N V E R S E   O R D E R   O F   E D G E S
 156       NFACE  = CG(KCGNF)
 157       DO 500 NF=1,NFACE
 158         CG(JCG + KCGAA) =-CG(JCG + KCGAA)
 159         CG(JCG + KCGBB) =-CG(JCG + KCGBB)
 160         CG(JCG + KCGCC) =-CG(JCG + KCGCC)
 161         CG(JCG + KCGDD) =-CG(JCG + KCGDD)
 162         NEDGE  = CG(JCG+KCGNE)
 163         JCG    = JCG + LCGFAC
 164         DO 400 NE=1,NEDGE
 165           X      = CG(JCG+KCGX1)
 166           Y      = CG(JCG+KCGY1)
 167           Z      = CG(JCG+KCGZ1)
 168           CG(JCG + KCGX1) = CG(JCG + KCGX2)
 169           CG(JCG + KCGY1) = CG(JCG + KCGY2)
 170           CG(JCG + KCGZ1) = CG(JCG + KCGZ2)
 171           CG(JCG + KCGX2) = X
 172           CG(JCG + KCGY2) = Y
 173           CG(JCG + KCGZ2) = Z
 174           JCG    = JCG + LCGEDG
 175   400     CONTINUE
 176   500   CONTINUE
 177 *
 178   999 RETURN
 179       END