New detector loop split in 2
[u/mrichter/AliRoot.git] / GEANT321 / ggeom / gsposp.F
CommitLineData
fe4da5cc 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)
13C.
14C. ******************************************************************
15C. * *
16C. * Place a copy of generic volume 'NAME' with user number *
17C. * 'NR' inside 'MOTHER', with its parameters UPAR(1..NP) *
18C. * *
19C. * JVO=pointer to mother volume *
20C. * JIN=pointer to the copy 'NAME','NR' *
21C. * JIN=LQ(JVO-IN) *
22C. * *
23C. * Q(JIN+1)=NENTRY *
24C. * Q(JIN+2)=VOLUME NUMBER *
25C. * Q(JIN+3)=USER NUMBER *
26C. * Q(JIN+4)=IROT *
27C. * Q(JIN+5)=X *
28C. * Q(JIN+6)=Y *
29C. * Q(JIN+7)=Z *
30C. * Q(JIN+8)=ONLY *
31C. * Q(JIN+9)=NPAR *
32C. * Q(JIN+10 ..)=PAR .. *
33C. * *
34C. * ==>Called by : <USER> *
35C. * Authors R.Brun, F.Bruyant, A.McPherson ********* *
36C. * *
37C. ******************************************************************
38C.
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)
46C.
47C. ------------------------------------------------------------------
48C.
49C Check if volume master bank exists
50C
51 IF(JVOLUM.GT.0)GO TO 10
52 WRITE(CHMAIL,1000)
53 CALL GMAIL(0,0)
54 GO TO 99
55C
56C Check if mother volume exists
57C
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
63C
64C Check if NAME volume exists
65C
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
71C
72C Check if rotation matrix exists
73C
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
83C
84C Check if mother is not divided
85C
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)
159C
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