This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / TGeant3 / galicef.F
CommitLineData
fe4da5cc 1*CMZ : 2.03/01 20/08/98 17.46.44 by Federico Carminati
2*CMZ : 2.00/01 20/04/98 10.51.01 by Unknown
3*CMZ : 2.00/00 16/04/98 12.54.34 by Unknown
4*CMZ : 1.05/00 08/06/94 09.19.45 by Nick van Eijndhoven (RUU/CERN)
5*-- Author : Nick van Eijndhoven (RUU/CERN) 08/06/94
6 SUBROUTINE SXPART
7C
8C *** DEFINITION OF ADDITIONAL PARTICLES AND DECAY MODES ***
9C *** NVE 08-JUL-1994 SAP UTRECHT ***
10C
11C CALLED BY : UGINIT
12C ORIGIN : NICK VAN EIJNDHOVEN
13C
14 DIMENSION BRATIO(6),MODE(6)
15C
16C --- Define additional particles
17 CALL GSPART(33,'OMEGA(783)',3,0.782, 0.,7.836E-23,0.,0)
18 CALL GSPART(34,'PHI(1020)' ,3,1.019, 0.,1.486E-22,0.,0)
19 CALL GSPART(35,'D +' ,4,1.870, 1.,1.066E-12,0.,0)
20 CALL GSPART(36,'D -' ,4,1.870,-1.,1.066E-12,0.,0)
21 CALL GSPART(37,'D 0' ,3,1.865, 0.,4.2E-13 ,0.,0)
22 CALL GSPART(38,'ANTI D 0' ,3,1.865, 0.,4.2E-13 ,0.,0)
23 CALL GSPART(42,'RHO +' ,4,0.768, 1.,4.353E-24,0.,0)
24 CALL GSPART(43,'RHO -' ,4,0.768,-1.,4.353E-24,0.,0)
25 CALL GSPART(44,'RHO 0' ,3,0.768, 0.,4.353E-24,0.,0)
26C
27C --- Define additional decay modes ---
28C --- omega(783) ---
29 DO KZ=1,6
30 BRATIO(KZ)=0
31 MODE(KZ)=0
32 ENDDO
33 IPA=33
34 BRATIO(1)=89.
35 BRATIO(2)=8.5
36 BRATIO(3)=2.5
37 MODE(1)=70809
38 MODE(2)=107
39 MODE(3)=908
40 CALL GSDK(IPA,BRATIO,MODE)
41C --- phi(1020) ---
42 DO KZ=1,6
43 BRATIO(KZ)=0
44 MODE(KZ)=0
45 ENDDO
46 IPA=34
47 BRATIO(1)=49.
48 BRATIO(2)=34.4
49 BRATIO(3)=12.9
50 BRATIO(4)=2.4
51 BRATIO(5)=1.3
52 MODE(1)=1112
53 MODE(2)=1610
54 MODE(3)=4407
55 MODE(4)=90807
56 MODE(5)=1701
57 CALL GSDK(IPA,BRATIO,MODE)
58C --- D+ ---
59 DO KZ=1,6
60 BRATIO(KZ)=0
61 MODE(KZ)=0
62 ENDDO
63 IPA=35
64 BRATIO(1)=25.
65 BRATIO(2)=25.
66 BRATIO(3)=25.
67 BRATIO(4)=25.
68 MODE(1)=80809
69 MODE(2)=120808
70 MODE(3)=111208
71 MODE(4)=110809
72 CALL GSDK(IPA,BRATIO,MODE)
73C --- D- ---
74 DO KZ=1,6
75 BRATIO(KZ)=0
76 MODE(KZ)=0
77 ENDDO
78 IPA=36
79 BRATIO(1)=25.
80 BRATIO(2)=25.
81 BRATIO(3)=25.
82 BRATIO(4)=25.
83 MODE(1)=90908
84 MODE(2)=110909
85 MODE(3)=121109
86 MODE(4)=120908
87 CALL GSDK(IPA,BRATIO,MODE)
88C --- D0 ---
89 DO KZ=1,6
90 BRATIO(KZ)=0
91 MODE(KZ)=0
92 ENDDO
93 IPA=37
94 BRATIO(1)=33.
95 BRATIO(2)=33.
96 BRATIO(3)=33.
97 MODE(1)=809
98 MODE(2)=1208
99 MODE(3)=1112
100 CALL GSDK(IPA,BRATIO,MODE)
101C --- Anti D0 ---
102 DO KZ=1,6
103 BRATIO(KZ)=0
104 MODE(KZ)=0
105 ENDDO
106 IPA=38
107 BRATIO(1)=33.
108 BRATIO(2)=33.
109 BRATIO(3)=33.
110 MODE(1)=809
111 MODE(2)=1109
112 MODE(3)=1112
113 CALL GSDK(IPA,BRATIO,MODE)
114C --- rho+ ---
115 DO KZ=1,6
116 BRATIO(KZ)=0
117 MODE(KZ)=0
118 ENDDO
119 IPA=42
120 BRATIO(1)=100.
121 MODE(1)=807
122 CALL GSDK(IPA,BRATIO,MODE)
123C --- rho- ---
124 DO KZ=1,6
125 BRATIO(KZ)=0
126 MODE(KZ)=0
127 ENDDO
128 IPA=43
129 BRATIO(1)=100.
130 MODE(1)=907
131 CALL GSDK(IPA,BRATIO,MODE)
132C --- rho0 ---
133 DO KZ=1,6
134 BRATIO(KZ)=0
135 MODE(KZ)=0
136 ENDDO
137 IPA=44
138 BRATIO(1)=100.
139 MODE(1)=707
140 CALL GSDK(IPA,BRATIO,MODE)
141C --- jpsi ---
142 DO KZ=1,6
143 BRATIO(KZ)=0
144 MODE(KZ)=0
145 ENDDO
146 IPA=113
147 BRATIO(1)=50.
148 BRATIO(2)=50.
149 MODE(1)=506
150 MODE(2)=605
151 CALL GSDK(IPA,BRATIO,MODE)
152C --- upsilon ---
153 IPA=114
154 CALL GSDK(IPA,BRATIO,MODE)
155C --- phi ---
156 IPA=115
157 CALL GSDK(IPA,BRATIO,MODE)
158C
159 RETURN
160 END
161*CMZ : 2.00/01 23/04/98 08.37.08 by Federico Carminati
162*CMZ : 2.00/00 16/04/98 12.54.34 by Unknown
163*CMZ : 1.05/00 08/06/94 09.19.45 by Nick van Eijndhoven (RUU/CERN)
164*-- Author : Nick van Eijndhoven (RUU/CERN) 08/06/94
165 SUBROUTINE SXSROT(NMAT,THETA1,PHI1,THETA2,PHI2,THETA3,PHI3)
166C
167C *** INITIALISATION OF THE ALICE ZEBRA STRUCTURE ***
168C *** FCA 22-APR-1998 CERN EP ***
169C
170C CALLED BY : *_GEOM, *_ROTM, *_TMED
171C ORIGIN : FEDERICO CARMINATI
172C
173#undef CERNLIB_GEANT321_GCBANK_INC
174#undef CERNLIB_GEANT321_GCLINK_INC
175#include "geant321/gcbank.inc"
176*KEND.
177*
178 NMAT=1
179 IF(JROTM.GT.0) THEN
180 NS=IQ(JROTM-2)
181 DO KZ=1,NS
182 IF(LQ(JROTM-KZ).EQ.0) THEN
183 NMAT=KZ
184 GOTO 10
185 ENDIF
186 ENDDO
187 NMAT=NS+1
188 ENDIF
189 10 CALL GSROTM(NMAT,THETA1,PHI1,THETA2,PHI2,THETA3,PHI3)
190*
191 999 END
192*CMZ : 30/12/98 16.23.44 by Rene Brun
193*-- Author : Rene Brun 30/12/98
194 subroutine setclip(name,xmin,xmax,ymin,ymax,zmin,zmax)
195*
196* define the clip box parameters for volume name
197*
198#undef CERNLIB_GEANT321_GCUNIT_INC
199#include "geant321/gcunit.inc"
200#undef CERNLIB_GEANT321_GCMUTR_INC
201#include "geant321/gcmutr.inc"
202#undef CERNLIB_GEANT321_GCGOBJ_INC
203#include "geant321/gcgobj.inc"
204*KEND.
205 character *(*) name
206 real xmin,xmax,ymin,ymax,zmin,zmax
207*
208 IHOLE=0
209 NCVOLS=NCVOLS+1
210 IF(NCVOLS.EQ.MULTRA)THEN
211 WRITE(CHMAIL, 10000)
21210000 FORMAT(' *** GXDRAW ***:',
213 + ' No more space to store MCVOL information.')
214 CALL GMAIL(0,0)
215 WRITE(CHMAIL, 10100)
21610100 FORMAT(' *** GXDRAW ***: Please reset MCVOL')
217 CALL GMAIL(0,0)
218 return
219 ENDIF
220 IF(XMIN.GE.XMAX.OR.YMIN.GE.YMAX.OR.ZMIN.GE.ZMAX)THEN
221 WRITE(CHMAIL,10200)
22210200 FORMAT(' Wrong Box limits. Check values ')
223 CALL GMAIL(0,0)
224 return
225 ENDIF
226****SG
227 GNNVV(NCVOLS)=NAME
228 GNASH(NCVOLS)='BOX'
229 GXMIN(NCVOLS)=XMIN
230 GXMAX(NCVOLS)=XMAX
231 GYMIN(NCVOLS)=YMIN
232 GYMAX(NCVOLS)=YMAX
233 GZMIN(NCVOLS)=ZMIN
234 GZMAX(NCVOLS)=ZMAX
235 IF(GXMIN(NCVOLS).GT.-99999.)IHOLE=1
236* Resetting Mcvol mode
237 IF(GNNVV(NCVOLS).EQ.'.')THEN
238 IHOLE=0
239 DO 10 JJ=1,NCVOLS
240 GNNVV(JJ)=' '
241 GXMIN(JJ)=-100000
242 GXMAX(JJ)=-99999
243 GYMIN(JJ)=-100000
244 GYMAX(JJ)=-99999
245 GZMIN(JJ)=-100000
246 GZMAX(JJ)=-99999
247 10 CONTINUE
248 NCVOLS=0
249 ENDIF
250 end
251
252 subroutine setbomb(boom)
253*
254* set the bomb factor
255*
256#undef CERNLIB_GEANT321_GCMUTR_INC
257#include "geant321/gcmutr.inc"
258*KEND.
259*
260 real boom
261*
262 gboom = boom
263 end