This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / TGeant3 / galicef.F
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
7 C
8 C *** DEFINITION OF ADDITIONAL PARTICLES AND DECAY MODES ***
9 C *** NVE 08-JUL-1994 SAP UTRECHT ***
10 C
11 C CALLED BY : UGINIT
12 C ORIGIN    : NICK VAN EIJNDHOVEN
13 C
14       DIMENSION BRATIO(6),MODE(6)
15 C
16 C --- 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)
26 C
27 C --- Define additional decay modes ---
28 C --- 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)
41 C --- 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)
58 C --- 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)
73 C --- 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)
88 C --- 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)
101 C --- 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)
114 C --- 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)
123 C --- 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)
132 C --- 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)
141 C --- 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)
152 C --- upsilon ---
153       IPA=114
154       CALL GSDK(IPA,BRATIO,MODE)
155 C --- phi ---
156       IPA=115
157       CALL GSDK(IPA,BRATIO,MODE)
158 C
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)
166 C
167 C *** INITIALISATION OF THE ALICE ZEBRA STRUCTURE ***
168 C *** FCA 22-APR-1998 CERN EP ***
169 C
170 C CALLED BY : *_GEOM, *_ROTM, *_TMED
171 C ORIGIN    : FEDERICO CARMINATI
172 C
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)
212 10000      FORMAT(' *** GXDRAW ***:',
213      +            ' No more space to store MCVOL information.')
214             CALL GMAIL(0,0)
215             WRITE(CHMAIL, 10100)
216 10100      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)
222 10200       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