GEANT321/ggeom/gfpara.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:49  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.28  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GFPARA (NAME, NUMBER, INTEXT, NPAR, NATT, PAR, ATT)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *    Fetch parameters and attributes                             *
  17 C.    *    of the volume NAME-NUMBER.                                  *
  18 C.    *    INTEXT is used to select internal (INTEXT=1)                *
  19 C.    *    or user parameters to be fetched.                           *
  20 C.    *                                                                *
  21 C.    *   Called by : GDPRTR, GDRAW, GDSPEC, GPVOLU                    *
  22 C.    *   Authors   : S.Banerjee, A.McPherson, P.Zanarini              *
  23 C.    *                                                                *
  24 C.    ******************************************************************
  25 C.
  26 #include "geant321/gcbank.inc"
  27 #include "geant321/gcnum.inc"
  28 #include "geant321/gconsp.inc"
  29       CHARACTER*4 NAME
  30       PARAMETER  (NLVMAX=15)
  31       DIMENSION  PAR(*), ATT(*), LVOLS(NLVMAX), LINDX(NLVMAX)
  32       LOGICAL BTEST
  33 C.
  34 C.    ------------------------------------------------------------------
  35 C.
  36       CALL GLOOK (NAME, IQ(JVOLUM+1), NVOLUM, IVO)
  37       IF (IVO.LE.0) GO TO 991
  38       JVO  = LQ(JVOLUM-IVO)
  39       ISH  = Q(JVO+2)
  40       NPAR = Q(JVO+5)
  41       NATT = Q(JVO+6)
  42       JATT = JVO + 6 + NPAR
  43 *
  44 * *** Find a suitable way to access the volume parameters
  45 *
  46       IF (INTEXT.NE.1.OR..NOT.BTEST(IQ(JVO),1)) THEN
  47          IF (NPAR.GT.0) THEN
  48 *
  49 *  **       From the JVO structure
  50 *
  51             JPAR = JVO + 6
  52          ELSE
  53 *
  54 *  **       From positioning of the volume in the mother
  55 *
  56             DO 15 IVOM = 1, NVOLUM
  57                IF (IVO.EQ.IVOM) GO TO 15
  58                JVOM = LQ(JVOLUM-IVOM)
  59                NINM = Q(JVOM+3)
  60                IF (NINM.LE.0)   GO TO 15
  61                DO 10 IN = 1, NINM
  62                   JINM = LQ(JVOM-IN)
  63                   IVOT = Q(JINM+2)
  64                   IF (IVOT.NE.IVO) GO TO 10
  65                   NUMR = Q(JINM+3)
  66                   IF (NUMR.EQ.NUMBER) GO TO 20
  67    10          CONTINUE
  68    15       CONTINUE
  69             GO TO 991
  70    20       JPAR = JINM + 9
  71             NPAR = Q(JPAR)
  72          ENDIF
  73 *
  74       ELSE
  75 *
  76 *  **    From development structure
  77 *
  78          CALL GLMOTH (NAME, NUMBER, NLDM, LVOLS, LINDX)
  79          IF (NLDM.LE.0) GO TO 991
  80          JVOM = LQ(JVOLUM-LVOLS(NLDM))
  81          NINM = Q(JVOM+3)
  82          IF (NINM.LT.0) THEN
  83             IN   = NUMBER
  84          ELSE
  85             DO 25 IN = 1, NINM
  86                JINM = LQ(JVOM-IN)
  87                IF (IFIX(Q(JINM+2)).NE.IVO)    GO TO 25
  88                IF (IFIX(Q(JINM+3)).EQ.NUMBER) GO TO 30
  89    25       CONTINUE
  90             GO TO 991
  91          ENDIF
  92    30    JPAR = LQ(LQ(JVOLUM-LVOLS(1)))
  93          IF (NLDM.GT.1) THEN
  94             DO 35 ILEV = 2, NLDM
  95                IF (IQ(JPAR+1).EQ.0) THEN
  96                   JPAR = LQ(JPAR-LINDX(ILEV))
  97                   IF (JPAR.EQ.0) GO TO 991
  98                ELSE IF (IQ(JPAR-3).GT.1) THEN
  99                   JPAR = LQ(JPAR-LINDX(ILEV))
 100                ELSE
 101                   JPAR = LQ(JPAR-1)
 102                ENDIF
 103    35       CONTINUE
 104          ENDIF
 105          IF (NINM.GT.0) THEN
 106             JPAR = LQ(JPAR-IN)
 107             IF (JPAR.EQ.0) GO TO 991
 108          ELSE
 109             IF (IN.GT.IQ(JPAR+1)) GO TO 991
 110             IF (IQ(JPAR-3).GT.1) THEN
 111                JPAR = LQ(JPAR-IN)
 112             ELSE
 113                JPAR = LQ(JPAR-1)
 114             ENDIF
 115          ENDIF
 116          JPAR = JPAR + 5
 117          NPAR = IQ(JPAR)
 118       ENDIF
 119 *
 120       IF (NPAR.LE.0) GO TO 999
 121       CALL UCOPY (Q(JPAR+1), PAR, NPAR)
 122       CALL UCOPY (Q(JATT+1), ATT, NATT)
 123 *
 124       IF (INTEXT.EQ.1) GO TO 999
 125       IF (ISH.EQ.28) THEN
 126 *
 127 *  **    NPAR : 30 ---> 12
 128 *
 129          NPAR = 12
 130 *
 131       ELSE IF (ISH.EQ.4) THEN
 132 *
 133 *  **    TRAP
 134 *
 135          NPAR=11
 136          PH = 0.
 137          IF (PAR(2).NE.0.) PH = ATAN2(PAR(3),PAR(2))*RADDEG
 138          TT = SQRT(PAR(2)**2+PAR(3)**2)
 139          PAR(2) = ATAN(TT)*RADDEG
 140          IF (PH.LT.0.0) PH = PH+360.0
 141          PAR(3) = PH
 142          PAR(7) = ATAN(PAR(7))*RADDEG
 143          IF (PAR(7).GT.90.0) PAR(7) = PAR(7)-180.0
 144          PAR(11)= ATAN(PAR(11))*RADDEG
 145          IF (PAR(11).GT.90.0) PAR(11) = PAR(11)-180.0
 146 *
 147       ELSE IF (ISH.EQ.10) THEN
 148 *
 149 *  **    PARA
 150 *
 151          PH = 0.
 152          IF (PAR(5).NE.0.) PH = ATAN2(PAR(6),PAR(5))*RADDEG
 153          TT = SQRT(PAR(5)**2+PAR(6)**2)
 154          PAR(4) = ATAN(PAR(4))*RADDEG
 155          IF (PAR(4).GT.90.0) PAR(4) = PAR(4)-180.0
 156          PAR(5) = ATAN(TT)*RADDEG
 157          IF (PH.LT.0.0) PH = PH+360.0
 158          PAR(6) = PH
 159       ENDIF
 160       GO TO 999
 161 *
 162   991 NPAR = 0
 163   999 RETURN
 164 *                                                             END GFPARA
 165       END