This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / ggeom / gsposp.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 GSPOSP(NAME,NR,MOTHER,X,Y,Z,IROT,KONLY,UPAR,NP)
13 C.
14 C.    ******************************************************************
15 C.    *                                                                *
16 C.    *      Place a copy of generic volume 'NAME' with user number    *
17 C.    *      'NR' inside 'MOTHER', with its parameters UPAR(1..NP)     *
18 C.    *                                                                *
19 C.    *          JVO=pointer to mother volume                          *
20 C.    *          JIN=pointer to the copy 'NAME','NR'                   *
21 C.    *          JIN=LQ(JVO-IN)                                        *
22 C.    *                                                                *
23 C.    *             Q(JIN+1)=NENTRY                                    *
24 C.    *             Q(JIN+2)=VOLUME NUMBER                             *
25 C.    *             Q(JIN+3)=USER NUMBER                               *
26 C.    *             Q(JIN+4)=IROT                                      *
27 C.    *             Q(JIN+5)=X                                         *
28 C.    *             Q(JIN+6)=Y                                         *
29 C.    *             Q(JIN+7)=Z                                         *
30 C.    *             Q(JIN+8)=ONLY                                      *
31 C.    *             Q(JIN+9)=NPAR                                      *
32 C.    *             Q(JIN+10 ..)=PAR ..                                *
33 C.    *                                                                *
34 C.    *    ==>Called by : <USER>                                       *
35 C.    *         Authors R.Brun, F.Bruyant,  A.McPherson  *********     *
36 C.    *                                                                *
37 C.    ******************************************************************
38 C.
39 #include "geant321/gcbank.inc"
40 #include "geant321/gcflag.inc"
41 #include "geant321/gcunit.inc"
42 #include "geant321/gcnum.inc"
43 #include "geant321/gconsp.inc"
44       CHARACTER*4 NAME,MOTHER,KONLY
45       DIMENSION UPAR(*),PAR(50)
46 C.
47 C.    ------------------------------------------------------------------
48 C.
49 C              Check if volume master bank exists
50 C
51       IF(JVOLUM.GT.0)GO TO 10
52       WRITE(CHMAIL,1000)
53       CALL GMAIL(0,0)
54       GO TO 99
55 C
56 C              Check if mother volume exists
57 C
58   10  CALL GLOOK(MOTHER,IQ(JVOLUM+1),NVOLUM,IVO)
59       IF(IVO.GT.0)GO TO 20
60       WRITE(CHMAIL,2000)MOTHER
61       CALL GMAIL(0,0)
62       GO TO 99
63 C
64 C              Check if NAME volume exists
65 C
66   20  CALL GLOOK(NAME,IQ(JVOLUM+1),NVOLUM,IN)
67       IF(IN.GT.0)GO TO 30
68       WRITE(CHMAIL,2000)NAME
69       CALL GMAIL(0,0)
70       GO TO 99
71 C
72 C              Check if rotation matrix exists
73 C
74   30  IF(IROT.LE.0)GO TO 50
75       IF(JROTM.GT.0)GO TO 40
76       WRITE(CHMAIL,3000)IROT
77       CALL GMAIL(0,0)
78       GO TO 99
79   40  IF(LQ(JROTM-IROT).GT.0)GO TO 50
80       WRITE(CHMAIL,3000)IROT
81       CALL GMAIL(0,0)
82       GO TO 99
83 C
84 C              Check if mother is not divided
85 C
86   50  JIN=LQ(JVOLUM-IN)
87       ISH=Q(JIN+2)
88       JVO=LQ(JVOLUM-IVO)
89       ICOPY=1
90       NIN=Q(JVO+3)
91       IF(NIN.GE.0)GO TO 60
92       WRITE(CHMAIL,4000)MOTHER
93       CALL GMAIL(0,0)
94       GO TO 99
95 *
96 * *** Copy user parameters into local array PAR
97   60  NPAR=NP
98       IF (ISH.EQ. 4) NPAR=35
99       IF (ISH.EQ.28) NPAR=30
100       CALL UCOPY(UPAR,PAR,NP)
101 *
102 * *** Check if ('NAME',NUMBER') exists
103       IF(NIN.EQ.0)GO TO 80
104       DO 70 I=1,NIN
105       JIN=LQ(JVO-I)
106       IF(Q(JIN+2).NE.IN)GO TO 70
107       IF(Q(JIN+3).NE.NR)GO TO 70
108       WRITE(CHMAIL,5000)NAME,NR
109       CALL GMAIL(0,0)
110       GO TO 90
111   70  CONTINUE
112       ICOPY=NIN+1
113 *
114 * *** Create bank for that copy
115   80  NINL=IQ(JVO-2)
116       IF(ICOPY.GT.NINL)CALL MZPUSH(IXCONS,JVO,50,0,'I')
117       CALL MZBOOK(IXCONS,JIN,JVO,-ICOPY,'VOPP',1,1,NPAR+9,3,0)
118       IF(IEOTRI.NE.0)GO TO 95
119       IQ(JIN-5)=100*IVO+ICOPY
120       Q(JVO+3)=Q(JVO+3)+1
121 *
122 * *** Now store parameters into bank area
123   90  Q(JIN+2)=IN
124       Q(JIN+3)=NR
125       Q(JIN+4)=IROT
126       Q(JIN+5)=X
127       Q(JIN+6)=Y
128       Q(JIN+7)=Z
129       IF(KONLY.EQ.'ONLY')Q(JIN+8)=1.
130       Q(JIN+9) = NPAR
131 *
132       IF (ISH.EQ.4) THEN
133 *        Trapezoid
134          TTH= TAN(PAR(2)*DEGRAD)
135          PHI    = PAR(3)*DEGRAD
136          PAR(2) = TTH*COS(PHI)
137          PAR(3) = TTH*SIN(PHI)
138          PAR(7) = TAN(PAR(7) *DEGRAD)
139          PAR(11)= TAN(PAR(11)*DEGRAD)
140          CALL GNOTR1 (PAR)
141       ELSE IF (ISH.EQ.10) THEN
142 *        Parallelepiped.
143          PAR(4)=TAN(PAR(4)*DEGRAD)
144          TTH=TAN(PAR(5)*DEGRAD)
145          PH=PAR(6)*DEGRAD
146          PAR(5)=TTH*COS(PH)
147          PAR(6)=TTH*SIN(PH)
148       ELSE IF (ISH.EQ.28) THEN
149 *        General twisted trapezoid.
150          CALL GTRAIN(UPAR,PAR)
151       ENDIF
152 *
153       CALL UCOPY(PAR,Q(JIN+10),NPAR)
154       GO TO 99
155 *
156 *     Not enough space
157   95  WRITE(CHMAIL,6000)NAME,NR,MOTHER
158       CALL GMAIL(0,0)
159 C
160  1000 FORMAT(' ***** GSPOSP CALLED AND NO VOLUMES DEFINED *****')
161  2000 FORMAT(' ***** GSPOSP VOLUME ',A4,' DOES NOT EXISTS *****')
162  3000 FORMAT(' ***** GSPOSP ROTATION MATRIX',I5,' DOES NOT EXIST *****')
163  4000 FORMAT(' ***** GSPOSP MOTHER ',A4,' ALREADY DIVIDED *****')
164  5000 FORMAT(' ***** GSPOSP COPY ',A4,' NUMBER ',I5,
165      +       ' ALREADY CREATED IN ',A4,' *****')
166  6000 FORMAT(' ***** GSPOSP NOT ENOUGH SPACE TO STORE COPY ',A4,
167      +       ' NUMBER ',I5,' IN ',A4,' *****')
168   99  RETURN
169       END