This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / 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