1 c ==================================================================
3 function coornew(el,er,angl,mmm)
9 write (*,*) ' coornew diagnostic bad esum=',esum
13 itip=newtipcell(mmnew)
16 elseif(itip.eq.2) then
18 xx=xcryexcrangl(ex,angl)
26 data p1,p2 /1.480, 1.600/
27 c ar - energy fraction right from boundary
41 c lead glass for my geant
43 c lead glass for my geant 2*2 cells
45 c corrections for crystalls 2*2, systematic is better than 0.25 mm for 3Gev geant showers
47 c end corrections for crystalls
54 c data p1,p2 /1.480, 1.600/
56 data p1,p2 /1.700, 1.150/
57 c ar - energy fraction right from boundary
72 function xcryexcrangl(ar,angl)
73 c FOR CRYSTALS ALICE parametrisation 23.02.98
74 c data p1,p2 /1.480, 1.600/
75 data p1,p2 /1.700, 1.150/
76 c ar - energy fraction right from boundary
78 c write (*,*) ' ar,angl ',ar,angl
106 c ==============================================================
107 real function cumulnew(xc,itip)
113 elseif(itip.eq.2) then
120 real function dcumulnew(xc,itip)
126 elseif(itip.eq.2) then
133 real function cucryexcr(xc)
134 c fit for ALICE 94 RUN DATA
135 c data p1,p2 /2.526, 1.104/
136 c94 data p1,p2 /2.300, 2.044/
137 c crystals for my geant
138 c data p1,p2 /1.480, 1.600/
140 data p1,p2 /1.700, 1.150/
142 a=0.5*exp((p1-sqrt(p1**2+4.*p2*x))/2./p2)
151 real function dcucryexcr(xc)
152 c fit for ALICE 94 RUN DATA
153 c data p1,p2 /2.526, 1.104/
154 c data p1,p2 /2.300, 2.044/
155 c crystals for my geant
156 c data p1,p2 /1.480, 1.600/
158 data p1,p2 /1.700, 1.150/
161 rr=sqrt(p1**2+4.*p2*x)
162 da=0.5*exp((p1-rr)/2./p2)/rr
168 real function cucryexgl(xc)
169 c fit for ALICE 94 RUN DATA
170 c data p1,p2 /2.526, 1.104/
171 c94 data p1,p2 /2.300, 2.044/
172 c crystals for my geant
173 data p1,p2 /1.480, 1.600/
175 c lead glass for my geant
178 a=0.5*exp((p1-sqrt(p1**2+4.*p2*x))/2./p2)
187 real function dcucryexgl(xc)
188 c fit for ALICE 94 RUN DATA
189 c data p1,p2 /2.526, 1.104/
190 c data p1,p2 /2.300, 2.044/
191 c crystals for my geant
192 data p1,p2 /1.480, 1.600/
194 c lead glass for my geant
197 rr=sqrt(p1**2+4.*p2*x)
198 da=0.5*exp((p1-rr)/2./p2)/rr
199 c lead glass for my geant
205 c ==============================================================
207 real function ampcelnew(e,vx,vc,vb,mmm)
208 common /comkey/ keykey
209 real vx(5),vc(3),vb(3)
213 itip=newtipcell(mmnew)
219 a=aclnew(xg-xc,yg-yc,vb,itip)
220 elseif(keykey.eq.1) then
224 write (*,*) ' Net takoi keykey !! ',keykey
231 real function dampcelnew(nd,e,vx,vc,vb,mmm)
232 common /comkey/keykey
233 real vx(5),vc(3),vb(3)
237 itip=newtipcell(mmnew)
245 da=dxaclnew(xg-xc,yg-yc,vb,itip)
247 da=dxaclnew(yg-yc,xg-xc,vb,itip)
249 write (*,*) ' net takoi nd ',nd
251 elseif(keykey.eq.1) then
253 da=dacl3(nd,e,vx,vc,vb)
255 write (*,*) ' net takoi keykey ',keykey
263 FUNCTION aclnew(XG,YG,DA,mmn)
265 C SHOWER FRACTION IN THE CELL
266 C XG,YG GAMMA COOR. X=0,Y=0 - CENTER OF THE CELL
267 C DA - SIZE OF THE CELL (MM)
274 C SY=SIGN(1.,YG) FOR ANGLE
283 aclnew=a2fnew(XP,YP,mmn)+a2fnew(XM,YM,mmn)-
284 - a2fnew(XP,YM,mmn)-a2fnew(XM,YP,mmn)
285 c write (*,*) ' xg,yg,dx,dy,acl ',xg,yg,dx,dy,acl
289 FUNCTION dxaclnew(XG,YG,DA,mmn)
291 C DXACL=D(ACL(X,Y,DA))/D(X)
296 C SY=SIGN(1.,YG) FOR ANGLE
304 A=dxa2fnew(XP,YP,mmn)+dxa2fnew(XM,YM,mmn)-
305 - dxa2fnew(XP,YM,mmn)-dxa2fnew(XM,YP,mmn)
310 FUNCTION a2fnew(X,Y,mmn)
319 FUNCTION dxa2fnew(X,Y,mmn)
321 EXTERNAL afnew,dafnew
324 dxa2fnew=daa2fz(ax,ay)*dafnew(x,mmn)
328 FUNCTION afnew(x,mmn)
329 afnew=cumulnew(x,mmn)
333 FUNCTION dafnew(x,mmn)
334 dafnew=dcumulnew(x,mmn)
338 function sigwlgam0(ewl,egam)
339 c write (*,*) ' ewl,egam ',ewl,egam
346 c sigwlgam0=0.36*(1.-fr/0.88)*sqwl
348 sfun=0.5*sin(3.14/0.7*xp)+0.5*sin(3.14/0.76*sqrt(xp*0.7))
349 c sfun=2.5*egam*sfun+0.13-0.13*xp
350 c fm=(1.+exp(-egam/0.2))
354 sfun=egam*fm*sfun+0.13-0.13*xp
355 c sigwlgam0=sqrt(egam)*sfun*sqwl
356 sigwlgam0=0.1/sqrt(egam)*sfun*sqwl
357 c write (*,*) ' fr sfun ',fr,sfun
358 c write (*,*) ' sigwlgam0 ',sigwlgam0,ewl,egam
364 function dispwlm(ewl,m)
366 common /comsigma/sigmaph,sigmapd,sigphsq,sigpdsq
371 dispwlm=dispph+disppd
376 real function zmidlshower(ee,m)