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