GEANT321/cgpack/cgzrev.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:19:45  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 CGZREV(RZ,A1,A2,NA,LCG,CG)
  13 ************************************************************************
  14 *                                                                      *
  15 *     Name: CGZREV                                                     *
  16 *     Author: E. Chernyaev                       Date:    05.02.89     *
  17 *                                                Revised:              *
  18 *                                                                      *
  19 *     Function: Create CG-object by revolution around Z-axis           *
  20 *                                                                      *
  21 *     References: CGSIZE, CGSAAN, CGZRE                                *
  22 *                                                                      *
  23 *     Input: RZ(2,4) - 4 node contour (1-st must be left lower node)   *
  24 *                A1 - initial angle                                    *
  25 *                A2 - end angle                                        *
  26 *                NA - number of steps on angle                         *
  27 *               LCG - max-size of CG-object                            *
  28 *                                                                      *
  29 *     Output: CG - CG-object                                           *
  30 *                  CG(1) - length of CG-object                         *
  31 *                        = 0 if error in parameters                    *
  32 *                        < 0 if no space                               *
  33 *                                                                      *
  34 *     Errors: none                                                     *
  35 *                                                                      *
  36 ************************************************************************
  37 #include "geant321/cggpar.inc"
  38 #include "geant321/cgdelt.inc"
  39 #include "geant321/cgcaan.inc"
  40       REAL      RZ(2,4),CG(*)
  41 #if !defined(CERNLIB_SINGLE)
  42       DOUBLE PRECISION  SINE,COSE
  43 #endif
  44       INTEGER   NFAC(4),NEDG(4)
  45 *-
  46       CG(KCGSIZ)  = 0.
  47 *           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
  48       DO 100 I=1,4
  49         IF (RZ(1,I) .LT. 0.)    GOTO 999
  50         K      = I + 1
  51         IF (I .EQ. 4)           K = 1
  52         RLENG  = ABS(RZ(1,I)-RZ(1,K))
  53         ZLENG  = ABS(RZ(2,I)-RZ(2,K))
  54         IF (RLENG.LT.EEWOR .AND. ZLENG.LT.EEWOR)        GOTO 999
  55   100   CONTINUE
  56       CALL CGSAAN(A1,A2,NA,NA,IREP)
  57 *           C O M P U T E   S I Z E   O F   C G - O B J E C T
  58       NFATYP = 4
  59       NEDG(1)= 3
  60       NEDG(2)= 4
  61       IF (IFULL .NE. 0)         NEDG(3)= NA
  62       IF (IFULL .EQ. 0)         NEDG(3)= NA + 2
  63       IF (IFULL .NE. 0)         NEDG(4)= NA + NA
  64       IF (IFULL .EQ. 0)         NEDG(4)= NA + NA + 2
  65       NFAC(1)= 0
  66       IF (IFULL .NE. 0)         NFAC(2)= 0
  67       IF (IFULL .EQ. 0)         NFAC(2)= 2
  68       NFAC(3)= 0
  69       NFAC(4)= 0
  70 *
  71       DO 150 I=1,4
  72         K      = I + 1
  73         IF (I .EQ. 4)           K = 1
  74         IF (RZ(1,I).LT.EEWOR .AND. RZ(1,K).LT.EEWOR)    GOTO 150
  75         IF (ABS(RZ(2,I)-RZ(2,K)) .LT. EEWOR)            GOTO 110
  76         J      = 2
  77         IF (RZ(1,I) .LT. EEWOR)    J = J - 1
  78         IF (RZ(1,K) .LT. EEWOR)    J = J - 1
  79         NFAC(J) = NFAC(J) + NA
  80         GOTO 150
  81   110   IF (ABS(RZ(1,I)-RZ(1,K)) .LT. EEWOR)            GOTO 150
  82         J      = 4
  83         IF (RZ(1,I) .LT. EEWOR)    J = J - 1
  84         IF (RZ(1,K) .LT. EEWOR)    J = J - 1
  85         NFAC(J) = NFAC(J) + 1
  86   150   CONTINUE
  87       CG(KCGSIZ)  = CGSIZE(LCG,NFATYP,NFAC,NEDG)
  88       IF (CG(KCGSIZ) .LE. 0.)   GOTO 999
  89 *
  90 **          C R E A T E   C G - O B J E C T
  91 *
  92       CG(KCGATT) = 0.
  93       CG(KCGNF)  = NFAC(1) + NFAC(2) + NFAC(3) + NFAC(4)
  94       JCG        = LCGHEA
  95       ATREDG     =-1.
  96       XYHA(2,1)  = 0.
  97       XYHA(2,2)  = 0.
  98       XYHA(4,1)  = 0.
  99       XYHA(4,2)  = 0.
 100       DO 200 I=1,4
 101         K      = I + 1
 102         IF (I .EQ. 4)           K = 1
 103         XYHA(1,1) = RZ(1,I)
 104         XYHA(3,1) = RZ(2,I)
 105         XYHA(1,2) = RZ(1,K)
 106         XYHA(3,2) = RZ(2,K)
 107         CALL CGZRE(2,CG(JCG+1),J)
 108         JCG    = JCG + J
 109   200   CONTINUE
 110       IF (IFULL .NE. 0.)        GOTO 999
 111 *           C R E A T E   S I D E   F A C E S
 112       CG(JCG+KCGAF) = 0.
 113       CG(JCG+KCGAA) = SINI
 114       CG(JCG+KCGBB) =-COSI
 115       CG(JCG+KCGCC) = 0.
 116       CG(JCG+KCGDD) = 0.
 117       CG(JCG+KCGNE) = 4.
 118       JCG    = JCG + LCGFAC
 119       DO 300 I=1,4
 120         K      = I + 1
 121         IF (I .EQ. 4)           K = 1
 122         CG(JCG+KCGAE) = 0.
 123         CG(JCG+KCGX1) = RZ(1,I)*COSI
 124         CG(JCG+KCGY1) = RZ(1,I)*SINI
 125         CG(JCG+KCGZ1) = RZ(2,I)
 126         CG(JCG+KCGX2) = RZ(1,K)*COSI
 127         CG(JCG+KCGY2) = RZ(1,K)*SINI
 128         CG(JCG+KCGZ2) = RZ(2,K)
 129         JCG    = JCG + LCGEDG
 130   300   CONTINUE
 131 *
 132       CG(JCG+KCGAF) = 0.
 133       COSE   = COS(A2*RAD)
 134       SINE   = SIN(A2*RAD)
 135       CG(JCG+KCGAA) =-SINE
 136       CG(JCG+KCGBB) = COSE
 137       CG(JCG+KCGCC) = 0.
 138       CG(JCG+KCGDD) = 0.
 139       CG(JCG+KCGNE) = 4.
 140       JCG    = JCG + LCGFAC
 141       DO 400 I=1,4
 142         K      = I + 1
 143         IF (I .EQ. 4)           K = 1
 144         CG(JCG+KCGAE) = 0.
 145         CG(JCG+KCGX1) = RZ(1,K)*COSE
 146         CG(JCG+KCGY1) = RZ(1,K)*SINE
 147         CG(JCG+KCGZ1) = RZ(2,K)
 148         CG(JCG+KCGX2) = RZ(1,I)*COSE
 149         CG(JCG+KCGY2) = RZ(1,I)*SINE
 150         CG(JCG+KCGZ2) = RZ(2,I)
 151         JCG    = JCG + LCGEDG
 152   400   CONTINUE
 153 *
 154   999 RETURN
 155       END