GEANT321/ggeom/gsvolu.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:56  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.30  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GSVOLU(KNAME,JSHAPE,NMED,UPAR,NP,IVOLU)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *        CREATES A NEW VOLUME                                    *
  17 C.    *                                                                *
  18 C.    *          JVO=LQ(JVOLUM-IVOLU)                                  *
  19 C.    *                                                                *
  20 C.    *            Q(JVO+1)=ISEARC (SET TO 0 BY DEFAULT)               *
  21 C.    *            Q(JVO+2)=ISHAPE                                     *
  22 C.    *            Q(JVO+3)=NIN                                        *
  23 C.    *            Q(JVO+4)=NMED                                       *
  24 C.    *            Q(JVO+5)=NPAR                                       *
  25 C.    *            Q(JVO+6)=NATT                                       *
  26 C.    *            Q(JVO+7)=PAR.....                                   *
  27 C.    *            Q(JVO+7+NPAR)=ATT.....                              *
  28 C.    *                                                                *
  29 C.    *    ==>Called by : <USER>                                       *
  30 C.    *         Author  R.Brun  *********                              *
  31 C.    *                                                                *
  32 C.    ******************************************************************
  33 C.
  34 #include "geant321/gcbank.inc"
  35 #include "geant321/gconsp.inc"
  36 #include "geant321/gcnum.inc"
  37 #include "geant321/gcdraw.inc"
  38 #include "geant321/gcunit.inc"
  39       CHARACTER*4 KNAME,JSHAPE
  40       DIMENSION UPAR(50),PAR(50),ATT(20)
  41       SAVE ATT,NATT
  42       DATA ATT/1.,1.,1.,1.,1.,15*0./
  43       DATA NATT/10/
  44 C.
  45 C.    ------------------------------------------------------------------
  46 C.
  47 C
  48 C              Copy user parameters into local array PAR
  49 C
  50       NPAR=NP
  51       IF (NP.GT.0) THEN
  52          IF(JSHAPE.EQ.'TRAP') NPAR=35
  53          IF(JSHAPE.EQ.'GTRA') NPAR=30
  54          CALL UCOPY(UPAR,PAR,NP)
  55       ENDIF
  56 C
  57       IVOLU=0
  58 C
  59 C              CHECK SHAPE VALIDITY
  60 C
  61       CALL GSCHK ( KNAME, JSHAPE, NPAR, ISHAPE )
  62 C
  63       IF(ISHAPE.LE.0)GO TO 99
  64       IF(JVOLUM.GT.0)GO TO 10
  65 C
  66 C              CREATE THE MOTHER MEDIA BANK
  67 C
  68       CALL MZBOOK(IXCONS,JVOLUM,JVOLUM,1,'VOLU',400,400,400,5,0)
  69       IVO=1
  70       NVOLUM=1
  71       GO TO 30
  72 C
  73 C              CHECK IF SUCH A VOLUME ALREADY DEFINED
  74 C
  75   10  NVOL=IQ(JVOLUM-2)
  76       CALL GLOOK(KNAME,IQ(JVOLUM+1),NVOLUM,IVO)
  77       IF(IVO.LE.0)GO TO 20
  78       IF(LQ(JVOLUM-IVO).GT.0) THEN
  79          WRITE(CHMAIL,10010) KNAME, IVO
  80 10010 FORMAT(' **** GSVOLU: Redefinition of volume ',
  81      +       A4,' IVO = ',I6)
  82          CALL GMAIL(0,0)
  83          CALL MZDROP(IXCONS,LQ(JVOLUM-IVO),' ')
  84       ENDIF
  85       GO TO 30
  86 C
  87   20  NVOLUM=NVOLUM+1
  88       IF(NVOLUM.GT.NVOL)CALL MZPUSH(IXCONS,JVOLUM,50,50,'I')
  89       IVO=NVOLUM
  90 C
  91 C              NOW CREATE THE VOLUME BANK
  92 C
  93   30  CALL MZBOOK(IXCONS,JVO,JVOLUM,-IVO,'VOL1',50,50,9+NPAR+NATT,3,0)
  94       CALL UCTOH(KNAME,IQ(JVOLUM+IVO),4,4)
  95 C
  96 C              COPY PARAMETERS IN DATA AREA
  97 C
  98       IVOLU=IVO
  99       Q(JVO+2)=ISHAPE
 100       Q(JVO+4)=NMED
 101       IF(NPAR.LE.0)GO TO 99
 102 *
 103       IF (ISHAPE.EQ.4) THEN
 104 *        Trapezoid
 105          TTH= TAN(PAR(2)*DEGRAD)
 106          PHI    = PAR(3)*DEGRAD
 107          PAR(2) = TTH*COS(PHI)
 108          PAR(3) = TTH*SIN(PHI)
 109          PAR(7) = TAN(PAR(7) *DEGRAD)
 110          PAR(11)= TAN(PAR(11)*DEGRAD)
 111          CALL GNOTR1 (PAR)
 112       ELSE IF (ISHAPE.EQ.10) THEN
 113 *        Parallelepiped change angles to tangents.
 114          PAR(4)=TAN(PAR(4)*DEGRAD)
 115          TTH=TAN(PAR(5)*DEGRAD)
 116          PH=PAR(6)*DEGRAD
 117          PAR(5)=TTH*COS(PH)
 118          PAR(6)=TTH*SIN(PH)
 119       ELSE IF (ISHAPE.EQ.28) THEN
 120 *        General twisted trapezoid.
 121          CALL GTRAIN(UPAR,PAR)
 122       ENDIF
 123 *
 124   99  CONTINUE
 125 *
 126       CALL GSIPAR(JVO,0,NPAR,NATT,PAR,ATT)
 127 *
 128       END