Removal of old PHOS reconstruction routines
[u/mrichter/AliRoot.git] / PHOS / AliPHOSf.F
CommitLineData
fe4da5cc 1*CMZ : 15/02/99 14.40.30 by Federico Carminati
2*CMZ : 2.03/01 20/08/98 09.43.00 by Federico Carminati
3*CMZ : 2.03/00 09/07/98 19.21.29 by Federico Carminati
4*CMZ : 2.00/05 25/05/98 14.39.01 by Federico Carminati
5*CMZ : 1.05/06 26/10/95 17.04.53 by Nick van Eijndhoven (RUU/CERN)
6*CMZ : 1.05/00 11/11/94 15.21.30 by Nick van Eijndhoven (RUU/CERN)
7*-- Author : Nick van Eijndhoven (CERN) 24/09/90
8 SUBROUTINE PHOS_INIT
9C
10C *** DEFINITION OF THE GEOMETRY OF THE PHOS ***
11C *** NVE 24-SEP-1990 CERN GENEVA ***
12C
13C CALLED BY : SXGEOM
14C ORIGIN : NICK VAN EIJNDHOVEN
15C
16*KEEP,GCKINE.
17 COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP
18 + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD
19C
20 INTEGER IKINE,ITRA,ISTAK,IVERT,IPART,ITRTYP,NAPART,IPAOLD
21 REAL PKINE,AMASS,CHARGE,TLIFE,VERT,PVERT
22C
23*KEEP,LUDAT1.
24 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
25 INTEGER MSTU,MSTJ
26 REAL PARU,PARJ
27 SAVE /LUDAT1/
28*
29*KEEP,SHRUNP.
30 COMMON /SHRUNP/ VMAJ,IMIN,NRUN,NEVTOT
31*KEEP,SHPHYP.
32 COMMON /SHPHYP/ JWEI,NDNDY,YLIM,PTLIM,JWEAK,JPI0,JETA,JPIC,JPRO,
33 + JKAC,JKA0,JRHO,JOME,JPHI,JPSI,JDRY
34*KEEP,SCPHOS.
35 INTEGER MAXCRAD
36 PARAMETER (MAXCRAD=100)
37 INTEGER PHOSsize,PHOS_Ndiv_magic
38 REAL PHOSflags,PHOScell,PHOSradius,PHOSCPV,
39 + PHOScradlesA,PHOSTXW,PHOSAIR,PHOSFTI,
40 + PHOSextra, PHOSangle
41 COMMON /PHOS_PARS/ PHOSflags(9),
42 + PHOScell(9),PHOSradius,PHOSCPV(9),
43 + PHOSsize(3), PHOScradlesA,
44 + PHOSTXW(3),PHOSAIR(3),PHOSFTI(4),
45 + PHOSextra(9), PHOSangle(MAXCRAD),
46 + PHOS_Ndiv_magic
47*KEND.
48C
49 IF (PHOSsize(3).GT.MAXCRAD) THEN
50 STOP 'PHOS_INIT Increase MAXCRAD, too many cradles!'
51 ENDIF
52
53*AZ { SHAKER initialization
54 IF( IKINE.EQ.700 ) THEN
55 JWEI = 0
56 NDNDY = NINT(PKINE(4))
57 YLIM = PKINE(5)
58 PTLIM = PKINE(6)
59 JWEAK = 0
60 JPI0 = 1
61 JETA = 1
62 JPIC = NINT(PKINE(7))
63 JPRO = NINT(PKINE(7))
64 JKAC = NINT(PKINE(7))
65 JKA0 = NINT(PKINE(7))
66 JRHO = NINT(PKINE(7))
67 JOME = NINT(PKINE(7))
68 JPHI = NINT(PKINE(7))
69 JPSI = NINT(PKINE(7))
70 JDRY = NINT(PKINE(7))
71 NEVTOT = 999999999
72
73 MSTU(11) = 6 ! Shaker output to screen (Fortran channel 6).
74 CALL SHINIT ! Shaker initialization.
75
76 print *,'************************************************'
77 print *,'Print some SHAKER parameters.'
78 print *,'NDNDY=',NDNDY
79 print *,'YLIM=',YLIM
80 print *,'PTLIM=',PTLIM
81 print *,'JPIC=',JPIC
82 print *,'************************************************'
83*AZ }
84
85 ENDIF
86*
87 END
88*CMZ : 15/02/99 14.40.30 by Federico Carminati
89*CMZ : 2.03/01 28/07/98 16.12.22 by Federico Carminati
90*-- Author : Federico Carminati 17/07/98
91 SUBROUTINE PHOS_KINE(NT)
92*KEEP,GCKINE.
93 COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP
94 + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD
95C
96 INTEGER IKINE,ITRA,ISTAK,IVERT,IPART,ITRTYP,NAPART,IPAOLD
97 REAL PKINE,AMASS,CHARGE,TLIFE,VERT,PVERT
98C
99*KEEP,SHGENE.
100 COMMON /SHGENE/ IEVT,NPI0,NETA,NPIC,NPRO,NKAC,NKA0,NRHO,NOME,
101 + NPHI,NPSI,NDRY
102*KEEP,BLUJETS.
103 COMMON /LUJETS/ N,K(200000,5),P(200000,5),V(200000,5)
104 SAVE /LUJETS/
105
106*KEEP,SCPHOS.
107 INTEGER MAXCRAD
108 PARAMETER (MAXCRAD=100)
109 INTEGER PHOSsize,PHOS_Ndiv_magic
110 REAL PHOSflags,PHOScell,PHOSradius,PHOSCPV,
111 + PHOScradlesA,PHOSTXW,PHOSAIR,PHOSFTI,
112 + PHOSextra, PHOSangle
113 COMMON /PHOS_PARS/ PHOSflags(9),
114 + PHOScell(9),PHOSradius,PHOSCPV(9),
115 + PHOSsize(3), PHOScradlesA,
116 + PHOSTXW(3),PHOSAIR(3),PHOSFTI(4),
117 + PHOSextra(9), PHOSangle(MAXCRAD),
118 + PHOS_Ndiv_magic
119*KEND.
120*
121 DIMENSION V_TMP(3),P_TMP(3)
122*
123 IF(IKINE.EQ.700) THEN
124* Shaker genrator SHOULD BE CHECKED!!!!
125 IEVT = IEVT + 1 ! Increament SHAKER event number.
126 CALL SHEVNT
127
128
129***********************************
130* Begin: create list of SHAKER particles (if required)
131* ------
132* PHOSflags: YES: X<>0 NO: X=0
133* PHOSflags(1) : -----X Create branch for TObjArray of AliPHOSCradle
134* ----X- Create file (ftn03 on HP-UX) with list of SHAKER particles (7Mb/event)
135 tmp = PHOSflags(1)/(10**2)
136 i = tmp
137 i = (tmp-i)*10
138
139 IF( i.NE.0. ) CALL SHLIST ! List of SHAKER particles. 7 Mbytes/event
140
141* End of creation
142************************************
143
144 DO I=1,N
145 !? IF( K_LUJETS(I,5).EQ.0 ) MPRIMA=MPRIMA+1
146 IPART = IPART_FROM_LUJET_TO_GEANT(K(I,2))
147
148 IF( K(I,5).EQ.0 ) THEN
149 IFLAG_DONE = 1
150 ELSE
151 IFLAG_DONE = 0
152 ENDIF
153 DO JJ=1,3
154 V_TMP(JJ)=V(I,JJ)
155 P_TMP(JJ)=P(I,JJ)
156 ENDDO
157 CALL RXSTRAK(IFLAG_DONE,K(I,3),IPART,P_TMP
158 $ ,V_TMP,V(I,4),'Primary',NT)
159 IF( I.NE.NT ) THEN
160 STOP 'GUKINE: Bad thing...'
161 ENDIF
162
163 CALL RXKEEP(I)
164 ENDDO
165
166 ENDIF
167 GOTO 999
168*
169 999 END
170 INTEGER FUNCTION IPART_FROM_LUJET_TO_GEANT(N)
171 ! Return GEANT particle number from LUJET particle number.
172 ! This code is from file shake005.f : SUBROUTINE SHTOGL
173
174 IMPLICIT NONE
175 INTEGER N
176
177 IF (N.EQ.0) THEN
178 IPART_FROM_LUJET_TO_GEANT = 0
179 ELSE IF (N.EQ.22) THEN
180 IPART_FROM_LUJET_TO_GEANT = 1 ! gamma
181 ELSE IF (N.EQ.-11) THEN
182 IPART_FROM_LUJET_TO_GEANT = 2
183 ELSE IF (N.EQ.11) THEN
184 IPART_FROM_LUJET_TO_GEANT = 3
185 ELSE IF (ABS(N).EQ.12) THEN
186 IPART_FROM_LUJET_TO_GEANT = 4
187 ELSE IF (ABS(N).EQ.14) THEN
188 IPART_FROM_LUJET_TO_GEANT = 4
189 ELSE IF (ABS(N).EQ.16) THEN
190 IPART_FROM_LUJET_TO_GEANT = 4
191 ELSE IF (N.EQ.-13) THEN
192 IPART_FROM_LUJET_TO_GEANT = 5
193 ELSE IF (N.EQ.13) THEN
194 IPART_FROM_LUJET_TO_GEANT = 6
195 ELSE IF (N.EQ.111) THEN
196 IPART_FROM_LUJET_TO_GEANT = 7
197 ELSE IF (N.EQ.211) THEN
198 IPART_FROM_LUJET_TO_GEANT = 8
199 ELSE IF (N.EQ.-211) THEN
200 IPART_FROM_LUJET_TO_GEANT = 9
201 ELSE IF (N.EQ.130) THEN
202 IPART_FROM_LUJET_TO_GEANT = 10
203 ELSE IF (N.EQ.321) THEN
204 IPART_FROM_LUJET_TO_GEANT = 11
205 ELSE IF (N.EQ.-321) THEN
206 IPART_FROM_LUJET_TO_GEANT = 12
207 ELSE IF (N.EQ.2112) THEN
208 IPART_FROM_LUJET_TO_GEANT = 13
209 ELSE IF (N.EQ.2212) THEN
210 IPART_FROM_LUJET_TO_GEANT = 14
211 ELSE IF (N.EQ.-2212) THEN
212 IPART_FROM_LUJET_TO_GEANT = 15
213 ELSE IF (N.EQ.310) THEN
214 IPART_FROM_LUJET_TO_GEANT = 16
215 ELSE IF (N.EQ.221) THEN
216 IPART_FROM_LUJET_TO_GEANT = 17 ! eta
217 ELSE IF (N.EQ.311) THEN ! This is (K0) and we set it to
218 IPART_FROM_LUJET_TO_GEANT = 10 ! GEANT K0 short
219 ELSE IF (N.EQ.-311) THEN ! This is (K~0) and we set it to
220 IPART_FROM_LUJET_TO_GEANT = 10 ! GEANT K0 short
221 ELSE
222 WRITE(*,*) 'Unknown LUJET particle ', N
223 stop
224 ENDIF
225 END
226
227********************************************************************************