]>
Commit | Line | Data |
---|---|---|
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) | |
16 | C. | |
17 | C. ****************************************************************** | |
18 | C. * * | |
19 | C. * Place a copy of generic volume 'NAME' with user number * | |
20 | C. * 'NR' inside 'MOTHER', with its parameters UPAR(1..NP) * | |
21 | C. * * | |
22 | C. * JVO=pointer to mother volume * | |
23 | C. * JIN=pointer to the copy 'NAME','NR' * | |
24 | C. * JIN=LQ(JVO-IN) * | |
25 | C. * * | |
26 | C. * Q(JIN+1)=NENTRY * | |
27 | C. * Q(JIN+2)=VOLUME NUMBER * | |
28 | C. * Q(JIN+3)=USER NUMBER * | |
29 | C. * Q(JIN+4)=IROT * | |
30 | C. * Q(JIN+5)=X * | |
31 | C. * Q(JIN+6)=Y * | |
32 | C. * Q(JIN+7)=Z * | |
33 | C. * Q(JIN+8)=ONLY * | |
34 | C. * Q(JIN+9)=NPAR * | |
35 | C. * Q(JIN+10 ..)=PAR .. * | |
36 | C. * * | |
37 | C. * ==>Called by : <USER> * | |
38 | C. * Authors R.Brun, F.Bruyant, A.McPherson ********* * | |
39 | C. * * | |
40 | C. ****************************************************************** | |
41 | C. | |
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 | 49 | C. |
50 | C. ------------------------------------------------------------------ | |
51 | C. | |
52 | C Check if volume master bank exists | |
53 | C | |
54 | IF(JVOLUM.GT.0)GO TO 10 | |
55 | WRITE(CHMAIL,1000) | |
56 | CALL GMAIL(0,0) | |
57 | GO TO 99 | |
58 | C | |
59 | C Check if mother volume exists | |
60 | C | |
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 | |
66 | C | |
67 | C Check if NAME volume exists | |
68 | C | |
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 | |
74 | C | |
75 | C Check if rotation matrix exists | |
76 | C | |
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 | |
86 | C | |
87 | C Check if mother is not divided | |
88 | C | |
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) | |
162 | C | |
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 |