GEANT321/cgpack/cgelli.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 CGELLI(RX,RY,RZ,KA,KB,LCG,CG)
  13 ************************************************************************
  14 *                                                                      *
  15 *     Name: CGELLI                                                     *
  16 *     Author: E. Chernyaev                       Date:    24.01.89     *
  17 *                                                Revised:              *
  18 *                                                                      *
  19 *     Function: Create CG-object for ELLIPSOID                         *
  20 *                                                                      *
  21 *     References: CGSIZE, CGSNOR                                       *
  22 *                                                                      *
  23 *     Input:  RX - 1-st radius                                         *
  24 *             RY - 2-nd radius                                         *
  25 *             RZ - 3-rd radius                                         *
  26 *             KA - number of latitude step                             *
  27 *             KB - number of longitude step                            *
  28 *            LCG - max-size of CG-object                               *
  29 *                                                                      *
  30 *     Output: CG - CG-object                                           *
  31 *                  CG(1) - length of CG-object                         *
  32 *                        = 0 if error in parameters                    *
  33 *                        < 0 if no space                               *
  34 *                                                                      *
  35 *     Errors: none                                                     *
  36 *                                                                      *
  37 ************************************************************************
  38 #include "geant321/cggpar.inc"
  39       REAL      CG(*)
  40       INTEGER   NFAC(2),NEDG(2)
  41 *-
  42       CG(KCGSIZ)  = 0.
  43 *           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
  44       IF (RX .LE. 0.)   GOTO 999
  45       IF (RY .LE. 0.)   GOTO 999
  46       IF (RZ .LE. 0.)   GOTO 999
  47       IF (KA .LT. 3)    GOTO 999
  48       IF (KB .LT. 2)    GOTO 999
  49 *           C O M P U T E   S I Z E   O F   C G - O B J E C T
  50       NFATYP = 2
  51       NFAC(1)= 2 * KA
  52       NEDG(1)= 3
  53       NFAC(2)= (KB - 2) * KA
  54       NEDG(2)= 4
  55       CG(KCGSIZ)  = CGSIZE(LCG,NFATYP,NFAC,NEDG)
  56       IF (CG(KCGSIZ) .LE. 0.)        GOTO 999
  57 *
  58 **          C R E A T E   C G - O B J E C T   F O R   E L L I P S O I D
  59 *
  60       CG(KCGATT) = 0.
  61       CG(KCGNF)  = NFAC(1) + NFAC(2)
  62       PI     = ATAN(1.) * 4.
  63       DA     = (PI+PI) / KA
  64       DB     = PI / KB
  65       JCOSB  = CG(KCGSIZ) - 2*(KB+KA) - 4
  66       JSINB  = JCOSB + KB + 1
  67       JCOSA  = JSINB + KB + 1
  68       JSINA  = JCOSA + KA + 1
  69 *           P R E P A R E   W O R K   T A B L E
  70       A      = 0.
  71       B      = 0.
  72       JA     = 0
  73       JB     = 0
  74   100 CG(JCOSA+JA)     = COS(A)
  75       CG(JCOSA+KA-JA)  = CG(JCOSA+JA)
  76       CG(JSINA+JA)     = SIN(A)
  77       CG(JSINA+KA-JA)  =-CG(JSINA+JA)
  78       JA     = JA + 1
  79       A      = A + DA
  80       IF (KA-JA-JA) 200,110,100
  81   110 CG(JCOSA+JA)     =-1.
  82       CG(JSINA+JA)     = 0.
  83 *
  84   200 CG(JCOSB+JB)    = COS(B)
  85       CG(JCOSB+KB-JB) =-CG(JCOSB+JB)
  86       CG(JSINB+JB)    = SIN(B)
  87       CG(JSINB+KB-JB) = CG(JSINB+JB)
  88       JB     = JB + 1
  89       B      = B + DB
  90       IF (KB-JB-JB) 300,210,200
  91   210 CG(JCOSB+JB)    = 0.
  92       CG(JSINB+JB)    = 1.
  93 *           C R E A T E   U P P E R   H A L F   O F   E L L I P S O I D
  94   300 JCG    = LCGHEA
  95       NB     = KB - KB/2
  96       DO 500 JB=1,NB
  97         Z1     = RZ*CG(JCOSB+JB-1)
  98         Z2     = RZ*CG(JCOSB+JB)
  99         X4     = RX*CG(JSINB+JB-1)
 100         X3     = RX*CG(JSINB+JB)
 101         Y4     = 0.
 102         Y3     = 0.
 103         DO 400 JA=1,KA
 104           CG(JCG+KCGAF) = 0.
 105           JCGNE  = JCG + KCGNE
 106           JCG    = JCG + LCGFAC
 107           X1     = X4
 108           X2     = X3
 109           X3     = RX*CG(JSINB+JB)   * CG(JCOSA+JA)
 110           X4     = RX*CG(JSINB+JB-1) * CG(JCOSA+JA)
 111           Y1     = Y4
 112           Y2     = Y3
 113           Y3     = RY*CG(JSINB+JB)   * CG(JSINA+JA)
 114           Y4     = RY*CG(JSINB+JB-1) * CG(JSINA+JA)
 115           CG(JCG+KCGAE) =-1.
 116           CG(JCG+KCGX1) = X1
 117           CG(JCG+KCGY1) = Y1
 118           CG(JCG+KCGZ1) = Z1
 119           CG(JCG+KCGX2) = X2
 120           CG(JCG+KCGY2) = Y2
 121           CG(JCG+KCGZ2) = Z2
 122 *
 123           CG(JCG+LCGEDG+KCGAE) =-1.
 124           CG(JCG+LCGEDG+KCGX1) = X2
 125           CG(JCG+LCGEDG+KCGY1) = Y2
 126           CG(JCG+LCGEDG+KCGZ1) = Z2
 127           CG(JCG+LCGEDG+KCGX2) = X3
 128           CG(JCG+LCGEDG+KCGY2) = Y3
 129           CG(JCG+LCGEDG+KCGZ2) = Z2
 130 *
 131           CG(JCG+LCGEDG+LCGEDG+KCGAE) =-1.
 132           CG(JCG+LCGEDG+LCGEDG+KCGX1) = X3
 133           CG(JCG+LCGEDG+LCGEDG+KCGY1) = Y3
 134           CG(JCG+LCGEDG+LCGEDG+KCGZ1) = Z2
 135           CG(JCG+LCGEDG+LCGEDG+KCGX2) = X4
 136           CG(JCG+LCGEDG+LCGEDG+KCGY2) = Y4
 137           CG(JCG+LCGEDG+LCGEDG+KCGZ2) = Z1
 138           NE     = 3
 139           IF(X1.EQ.X4 .AND. Y1.EQ.Y4) GOTO 350
 140           NE     = 4
 141           CG(JCG+LCGEDG+LCGEDG+LCGEDG+KCGAE) =-1.
 142           CG(JCG+LCGEDG+LCGEDG+LCGEDG+KCGX1) = X4
 143           CG(JCG+LCGEDG+LCGEDG+LCGEDG+KCGY1) = Y4
 144           CG(JCG+LCGEDG+LCGEDG+LCGEDG+KCGZ1) = Z1
 145           CG(JCG+LCGEDG+LCGEDG+LCGEDG+KCGX2) = X1
 146           CG(JCG+LCGEDG+LCGEDG+LCGEDG+KCGY2) = Y1
 147           CG(JCG+LCGEDG+LCGEDG+LCGEDG+KCGZ2) = Z1
 148   350     JCG    = JCG + NE*LCGEDG
 149           CG(JCGNE) = NE
 150   400     CONTINUE
 151   500   CONTINUE
 152 *           C R E A T E   L O W E R   H A L F   O F   E L L I P S O I D
 153       JSTOP  = JCG
 154       JCGUP  = LCGHEA
 155       JCGLOW = CG(KCGSIZ)
 156   600 NE     = CG(JCGUP+KCGNE)
 157       JCGLOW = JCGLOW - LCGFAC - NE*LCGEDG
 158       IF (JCGLOW .LT. JSTOP)    GOTO 999
 159       CG(JCGLOW+KCGAF) = CG(JCGUP+KCGAF)
 160       CG(JCGLOW+KCGNE) = NE
 161       JL     = JCGLOW + LCGFAC
 162       JU     = JCGUP  + LCGFAC
 163 *
 164       CG(JL+KCGAE) = CG(JU+KCGAE)
 165       CG(JL+KCGX1) = CG(JU+KCGX2)
 166       CG(JL+KCGY1) = CG(JU+KCGY2)
 167       CG(JL+KCGZ1) =-CG(JU+KCGZ2)
 168       CG(JL+KCGX2) = CG(JU+KCGX1)
 169       CG(JL+KCGY2) = CG(JU+KCGY1)
 170       CG(JL+KCGZ2) =-CG(JU+KCGZ1)
 171       JU = JU + (NE-1)*LCGEDG
 172 *
 173       CG(JL+LCGEDG+KCGAE) = CG(JU+KCGAE)
 174       CG(JL+LCGEDG+KCGX1) = CG(JU+KCGX2)
 175       CG(JL+LCGEDG+KCGY1) = CG(JU+KCGY2)
 176       CG(JL+LCGEDG+KCGZ1) =-CG(JU+KCGZ2)
 177       CG(JL+LCGEDG+KCGX2) = CG(JU+KCGX1)
 178       CG(JL+LCGEDG+KCGY2) = CG(JU+KCGY1)
 179       CG(JL+LCGEDG+KCGZ2) =-CG(JU+KCGZ1)
 180 *
 181       CG(JL+LCGEDG+LCGEDG+KCGAE) = CG(JU-LCGEDG+KCGAE)
 182       CG(JL+LCGEDG+LCGEDG+KCGX1) = CG(JU-LCGEDG+KCGX2)
 183       CG(JL+LCGEDG+LCGEDG+KCGY1) = CG(JU-LCGEDG+KCGY2)
 184       CG(JL+LCGEDG+LCGEDG+KCGZ1) =-CG(JU-LCGEDG+KCGZ2)
 185       CG(JL+LCGEDG+LCGEDG+KCGX2) = CG(JU-LCGEDG+KCGX1)
 186       CG(JL+LCGEDG+LCGEDG+KCGY2) = CG(JU-LCGEDG+KCGY1)
 187       CG(JL+LCGEDG+LCGEDG+KCGZ2) =-CG(JU-LCGEDG+KCGZ1)
 188       IF (NE .EQ. 3)    GOTO 700
 189 *
 190       CG(JL+LCGEDG+LCGEDG+LCGEDG+KCGAE) = CG(JU-LCGEDG-LCGEDG+KCGAE)
 191       CG(JL+LCGEDG+LCGEDG+LCGEDG+KCGX1) = CG(JU-LCGEDG-LCGEDG+KCGX2)
 192       CG(JL+LCGEDG+LCGEDG+LCGEDG+KCGY1) = CG(JU-LCGEDG-LCGEDG+KCGY2)
 193       CG(JL+LCGEDG+LCGEDG+LCGEDG+KCGZ1) =-CG(JU-LCGEDG-LCGEDG+KCGZ2)
 194       CG(JL+LCGEDG+LCGEDG+LCGEDG+KCGX2) = CG(JU-LCGEDG-LCGEDG+KCGX1)
 195       CG(JL+LCGEDG+LCGEDG+LCGEDG+KCGY2) = CG(JU-LCGEDG-LCGEDG+KCGY1)
 196       CG(JL+LCGEDG+LCGEDG+LCGEDG+KCGZ2) =-CG(JU-LCGEDG-LCGEDG+KCGZ1)
 197   700 JCGUP  = JCGUP + LCGFAC + NE*LCGEDG
 198       GOTO 600
 199 *
 200   999 CALL CGSNOR(CG)
 201       RETURN
 202       END