GEANT321/cgpack/cgzre.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 CGZRE(K,CG,LCG)
  13 ************************************************************************
  14 *                                                                      *
  15 *     Name: CGZROT                                                     *
  16 *     Author: E. Chernyaev                       Date:    01.02.89     *
  17 *                                                Revised:              *
  18 *                                                                      *
  19 *     Function: Rotate edge about Z-axis                               *
  20 *                                                                      *
  21 *     References: none                                                 *
  22 *                                                                      *
  23 *     Input: K  - number for step                                      *
  24 *            CG - CG-object                                            *
  25 *                                                                      *
  26 *     Output: LCG - last index in CG-object                            *
  27 *                                                                      *
  28 *     Errors: none                                                     *
  29 *                                                                      *
  30 ************************************************************************
  31 #include "geant321/cggpar.inc"
  32 #include "geant321/cgdelt.inc"
  33 #include "geant321/cgcaan.inc"
  34 #if !defined(CERNLIB_SINGLE)
  35       DOUBLE PRECISION  X1,Y1,H1,X2,Y2,H2,AW,AA,BB,CC,DD,S
  36       DOUBLE PRECISION  D1,D2,DX1,DY1,DH1,DX2,DY2,DH2
  37 #endif
  38       REAL      CG(*)
  39 *-
  40       J      = 0
  41       D1     = ABS(XYHA(1,1)) + ABS(XYHA(2,1))
  42       D2     = ABS(XYHA(1,2)) + ABS(XYHA(2,2))
  43       IF (D1.LT.EEWOR .AND. D2.LT.EEWOR)        GOTO 999
  44       X1     = XYHA(1,1)*COSI - XYHA(2,1)*SINI
  45       Y1     = XYHA(1,1)*SINI + XYHA(2,1)*COSI
  46       X2     = XYHA(1,2)*COSI - XYHA(2,2)*SINI
  47       Y2     = XYHA(1,2)*SINI + XYHA(2,2)*COSI
  48       H1     = XYHA(3,1)
  49       H2     = XYHA(3,2)
  50       IF (ABS(H1-H2) .LT. EEWOR)               GOTO 200
  51       DX1    = X1 - (X2*COSDA(K)-Y2*SINDA(K))
  52       DY1    = Y1 - (X2*SINDA(K)+Y2*COSDA(K))
  53       DH1    = H1 - H2
  54       DX2    = (X1*COSDA(K)-Y1*SINDA(K)) - X2
  55       DY2    = (X1*SINDA(K)+Y1*COSDA(K)) - Y2
  56       DH2    = H1 - H2
  57       AA     = DY1*DH2 - DY2*DH1
  58       BB     = DH1*DX2 - DH2*DX1
  59       CC     = DX1*DY2 - DX2*DY1
  60       S      = SQRT(AA*AA + BB*BB + CC*CC)
  61       IF (S .LT. EEWOR)                         GOTO 999
  62       AA     = AA / S
  63       BB     = BB / S
  64       CC     = CC / S
  65       DD     =-(AA*X1 + BB*Y1 + CC*H1)
  66       DO 130 I=1,NASTP(K)
  67         CG(J+KCGAF) = 0.
  68         CG(J+KCGAA) = AA
  69         CG(J+KCGBB) = BB
  70         CG(J+KCGCC) = CC
  71         CG(J+KCGDD) = DD
  72         AW     = AA*COSDA(K) - BB*SINDA(K)
  73         BB     = AA*SINDA(K) + BB*COSDA(K)
  74         AA     = AW
  75         CG(J+KCGNE) = 4.
  76         IF (D1.LT.EEWOR .OR. D2.LT.EEWOR)       CG(J+KCGNE) = 3.
  77         J      = J + LCGFAC
  78 *
  79         CG(J+KCGAE) = ATREDG
  80         IF (I.EQ.1 .AND. IFULL.EQ.0)    CG(J+KCGAE) = 0.
  81         CG(J+KCGX1) = X2
  82         CG(J+KCGY1) = Y2
  83         CG(J+KCGZ1) = H2
  84         CG(J+KCGX2) = X1
  85         CG(J+KCGY2) = Y1
  86         CG(J+KCGZ2) = H1
  87         J      = J + LCGEDG
  88 *
  89         IF (D1 .LT. EEWOR)              GOTO 110
  90         CG(J+KCGAE) = XYHA(4,1)
  91         CG(J+KCGX1) = X1
  92         CG(J+KCGY1) = Y1
  93         CG(J+KCGZ1) = H1
  94         IF (I.NE.NASTP(K) .OR.  IFULL.EQ.0)
  95      +                         CG(J+KCGX2) = X1*COSDA(K) - Y1*SINDA(K)
  96         IF (I.NE.NASTP(K) .OR.  IFULL.EQ.0)
  97      +                         CG(J+KCGY2) = X1*SINDA(K) + Y1*COSDA(K)
  98         IF (I.EQ.NASTP(K) .AND. IFULL.NE.0)
  99      +                         CG(J+KCGX2) = CG(LCGFAC+KCGX2)
 100         IF (I.EQ.NASTP(K) .AND. IFULL.NE.0)
 101      +                         CG(J+KCGY2) = CG(LCGFAC+KCGY2)
 102         CG(J+KCGZ2) = H1
 103         X1     = CG(J+KCGX2)
 104         Y1     = CG(J+KCGY2)
 105         J      = J + LCGEDG
 106 *
 107   110   IF (D2 .LT. EEWOR)              GOTO 120
 108         CG(J+KCGAE) = XYHA(4,2)
 109         CG(J+KCGX2) = X2
 110         CG(J+KCGY2) = Y2
 111         CG(J+KCGZ2) = H2
 112         IF (I.NE.NASTP(K) .OR.  IFULL.EQ.0)
 113      +                         CG(J+KCGX1) = X2*COSDA(K) - Y2*SINDA(K)
 114         IF (I.NE.NASTP(K) .OR.  IFULL.EQ.0)
 115      +                         CG(J+KCGY1) = X2*SINDA(K) + Y2*COSDA(K)
 116         IF (I.EQ.NASTP(K) .AND. IFULL.NE.0)
 117      +                         CG(J+KCGX1) = CG(LCGFAC+KCGX1)
 118         IF (I.EQ.NASTP(K) .AND. IFULL.NE.0)
 119      +                         CG(J+KCGY1) = CG(LCGFAC+KCGY1)
 120         CG(J+KCGZ1) = H2
 121         X2     = CG(J+KCGX1)
 122         Y2     = CG(J+KCGY1)
 123         J      = J + LCGEDG
 124 *
 125   120   CG(J+KCGAE) = ATREDG
 126         IF (I.EQ.NASTP(K) .AND. IFULL.EQ.0)     CG(J+KCGAE) = 0.
 127         CG(J+KCGX1) = X1
 128         CG(J+KCGY1) = Y1
 129         CG(J+KCGZ1) = H1
 130         CG(J+KCGX2) = X2
 131         CG(J+KCGY2) = Y2
 132         CG(J+KCGZ2) = H2
 133         J      = J + LCGEDG
 134   130   CONTINUE
 135       GOTO 999
 136 *
 137 **          M A K E   H O R I Z O N T A L   F A C E
 138 *
 139   200 DD     = D1 - D2
 140       IF (ABS(DD) .LT. EEWOR)          GOTO 999
 141       K1     = K
 142       K2     = 3 - K
 143       CG(J+KCGAF) = 0.
 144       CG(J+KCGAA) = 0.
 145       CG(J+KCGBB) = 0.
 146       IF (DD .GT. 0)                    CG(J+KCGCC) = 1.
 147       IF (DD .LT. 0)                    CG(J+KCGCC) =-1.
 148       CG(J+KCGDD) =-XYHA(3,1) * CG(J+KCGCC)
 149       NEDGE  = 0.
 150       IF (D1 .GT. 0)                    NEDGE = NEDGE + NASTP(K1)
 151       IF (D2 .GT. 0)                    NEDGE = NEDGE + NASTP(K2)
 152       IF (IFULL .EQ. 0)                 NEDGE = NEDGE + 2
 153       CG(J+KCGNE) = NEDGE
 154       J      = J + LCGFAC
 155       IF (IFULL .NE. 0)                 GOTO 210
 156       CG(J+KCGAE) = 0.
 157       CG(J+KCGX1) = X2
 158       CG(J+KCGY1) = Y2
 159       CG(J+KCGZ1) = H2
 160       CG(J+KCGX2) = X1
 161       CG(J+KCGY2) = Y1
 162       CG(J+KCGZ2) = H1
 163       J      = J + LCGEDG
 164   210 IF (D1 .EQ. 0.)                    GOTO 230
 165       DO 220 I=1,NASTP(K1)
 166         CG(J+KCGAE) = XYHA(4,1)
 167         CG(J+KCGX1) = X1
 168         CG(J+KCGY1) = Y1
 169         CG(J+KCGZ1) = H1
 170         CG(J+KCGX2) = X1*COSDA(K1) - Y1*SINDA(K1)
 171         CG(J+KCGY2) = X1*SINDA(K1) + Y1*COSDA(K1)
 172         CG(J+KCGZ2) = H1
 173         X1     = CG(J+KCGX2)
 174         Y1     = CG(J+KCGY2)
 175         J      = J + LCGEDG
 176   220   CONTINUE
 177       IF (IFULL .EQ. 0)                  GOTO 230
 178       X1     = XYHA(1,1)*COSI - XYHA(2,1)*SINI
 179       Y1     = XYHA(1,1)*SINI + XYHA(2,1)*COSI
 180       CG(J-LCGEDG+KCGX2) = X1
 181       CG(J-LCGEDG+KCGY2) = Y1
 182 *
 183   230 IF (D2 .EQ. 0.)                    GOTO 250
 184       DO 240 I=1,NASTP(K2)
 185         CG(J+KCGAE) = XYHA(4,2)
 186         CG(J+KCGX2) = X2
 187         CG(J+KCGY2) = Y2
 188         CG(J+KCGZ2) = H2
 189         CG(J+KCGX1) = X2*COSDA(K2) - Y2*SINDA(K2)
 190         CG(J+KCGY1) = X2*SINDA(K2) + Y2*COSDA(K2)
 191         CG(J+KCGZ1) = H2
 192         X2     = CG(J+KCGX1)
 193         Y2     = CG(J+KCGY1)
 194         J      = J + LCGEDG
 195   240   CONTINUE
 196       IF (IFULL .EQ. 0)                  GOTO 250
 197       X2     = XYHA(1,2)*COSI - XYHA(2,2)*SINI
 198       Y2     = XYHA(1,2)*SINI + XYHA(2,2)*COSI
 199       CG(J-LCGEDG+KCGX1) = X2
 200       CG(J-LCGEDG+KCGY1) = Y2
 201 *
 202   250 IF (IFULL .NE. 0)                 GOTO 999
 203       CG(J+KCGAE) = 0.
 204       CG(J+KCGX1) = X1
 205       CG(J+KCGY1) = Y1
 206       CG(J+KCGZ1) = H1
 207       CG(J+KCGX2) = X2
 208       CG(J+KCGY2) = Y2
 209       CG(J+KCGZ2) = H2
 210       J      = J + LCGEDG
 211 *
 212   999 LCG    = J
 213       RETURN
 214       END