1 |
C |
2 |
C |
3 |
C NOTE: THIS ROUTINE DOES NOT SEEMS TO WORK CORRECTLY, HAS TO BE CHECKED CAREFULLY |
4 |
C |
5 |
C |
6 |
C--------------------------------------------------------------------- |
7 |
SUBROUTINE SELFTRIG |
8 |
C--------------------------------------------------------------------- |
9 |
C |
10 |
IMPLICIT NONE |
11 |
C |
12 |
INCLUDE 'INTEST.TXT' |
13 |
C |
14 |
REAL PI,calwidth,ztopx,ztopy,zbotx,zboty,MIP2GEV |
15 |
real wcorr |
16 |
parameter (wcorr=1.0) |
17 |
PARAMETER (MIP2GEV=0.0001059994) |
18 |
PARAMETER (PI=3.14159265358979324) |
19 |
CC PARAMETER (calwidth=24.2) |
20 |
PARAMETER (calwidth=24.1) |
21 |
PARAMETER (ztopx=-26.18) |
22 |
PARAMETER (ztopy=-26.76) |
23 |
PARAMETER (zbotx=-45.17) |
24 |
PARAMETER (zboty=-45.75) |
25 |
C |
26 |
INTEGER i,j,it |
27 |
INTEGER ifin,finpar,finpar1,plent,plentx,plenty |
28 |
INTEGER xncnt(22),yncnt(22),Nfitx,Nfity |
29 |
INTEGER xncnt2(5,22),yncnt2(5,22) |
30 |
C |
31 |
REAL xecnt2(5,22),xwght2(5,22),xcorr2(5,22) |
32 |
REAL yecnt2(5,22),ywght2(5,22),ycorr2(5,22) |
33 |
REAL ax2(4),bx2(4),eax2(4),ebx2(4) |
34 |
REAL ay2(4),by2(4),eay2(4),eby2(4) |
35 |
REAL xEmax3(22),yEmax3(22),xmax(22),ymax(22),zx(22),zy(22) |
36 |
REAL xecnt(22),xwght(22),xcorr(22) |
37 |
REAL yecnt(22),ywght(22),ycorr(22) |
38 |
REAL ax,bx,eax,ebx,chi2x,qxp,posixmd |
39 |
REAL ay,by,eay,eby,chi2y,qyp,posiymd |
40 |
REAL thxm,thym,tmisd,dthxm,dthym,dtmisd,pmisd,pmid |
41 |
REAL enet,parze,parz(2,22),ffla,zetamx,zetamy,fflaco,parzen2 |
42 |
REAL parzen3,funcor2 |
43 |
REAL CORRANG,ENCORR |
44 |
C |
45 |
COMMON / slftrig / tmisd,ax,bx,eax,ebx,chi2x,Nfitx,ay,by,eay,eby, |
46 |
& chi2y,Nfity,parzen3 |
47 |
SAVE / slftrig / |
48 |
C |
49 |
COMMON / debug / xncnt2,yncnt2,xecnt2,xwght2,xcorr2,yecnt2,ywght2, |
50 |
& ycorr2,ax2,bx2,eax2,ebx2,ay2,by2,eay2,eby2,zx,zy |
51 |
SAVE / debug / |
52 |
C |
53 |
c Energy calculation |
54 |
C |
55 |
enet = 0. |
56 |
parze = 0. |
57 |
finpar = 1 |
58 |
finpar1 = 1 |
59 |
CALL VZERO(parz,2*22) |
60 |
DO i = 1,22 |
61 |
DO j = 1,96 |
62 |
parz(1,i) = parz(1,i) + DEXY(1,i,j) ! sum up the energy in each x-plane |
63 |
parz(2,i) = parz(2,i) + DEXY(2,i,j) ! sum up the energy in each y-plane |
64 |
enet = enet + DEXY(1,i,j) + DEXY(2,i,j) ! sum up the total energy |
65 |
ENDDO |
66 |
IF (parz(1,i).GE.parze) THEN ! find plane with max energy |
67 |
parze = parz(1,i) ! the energy |
68 |
finpar = i ! the plane number |
69 |
finpar1 = 1 ! set x or y indicator |
70 |
ENDIF |
71 |
IF (parz(2,i).GE.parze) THEN |
72 |
parze = parz(2,i) |
73 |
finpar = i |
74 |
finpar1 = 2 |
75 |
ENDIF |
76 |
ENDDO |
77 |
ffla = FLOAT(finpar) |
78 |
IF (finpar1.EQ.1) THEN |
79 |
ffla = ffla - 1. |
80 |
ENDIF |
81 |
C |
82 |
c Find the center of the 3 strips with maximum total energy in a plane |
83 |
C |
84 |
CALL VZERO(xemax3,22) |
85 |
CALL VZERO(xncnt,22) |
86 |
CALL VZERO(yemax3,22) |
87 |
CALL VZERO(yncnt,22) |
88 |
DO i = 1,22 |
89 |
DO j = 1,94 |
90 |
|
91 |
IF ((DEXY(1,i,j)+ |
92 |
& DEXY(1,i,j+1)+ |
93 |
& DEXY(1,i,j+2)).GT.xemax3(i)) THEN |
94 |
xemax3(i)=DEXY(1,i,j)+ |
95 |
& DEXY(1,i,j+1)+ |
96 |
& DEXY(1,i,j+2) |
97 |
xncnt(i)=j+1 |
98 |
ENDIF |
99 |
IF ((DEXY(2,i,j)+ |
100 |
& DEXY(2,i,j+1)+ |
101 |
& DEXY(2,i,j+2)).GT.yemax3(i)) THEN |
102 |
yemax3(i)=DEXY(2,i,j)+ |
103 |
& DEXY(2,i,j+1)+ |
104 |
& DEXY(2,i,j+2) |
105 |
yncnt(i)=j+1 |
106 |
ENDIF |
107 |
|
108 |
ENDDO |
109 |
ENDDO |
110 |
C |
111 |
c Calculate the position of the center strip and the center of |
112 |
c energy (CoE) of 4 surrounding strips |
113 |
C |
114 |
DO i=1,22 |
115 |
CALL STRIP2POS(1,i,xncnt(i),xmax(i),zx(i)) |
116 |
CALL STRIP2POS(2,i,yncnt(i),ymax(i),zy(i)) |
117 |
CALL ENCENT2(1,xncnt(i),i,4,xecnt(i),xwght(i)) |
118 |
CALL ENCENT2(2,yncnt(i),i,4,yecnt(i),ywght(i)) |
119 |
xecnt2(1,i)=xecnt(i) |
120 |
xwght2(1,i)=xwght(i) |
121 |
xncnt2(1,i)=xncnt(i) |
122 |
yecnt2(1,i)=yecnt(i) |
123 |
ywght2(1,i)=ywght(i) |
124 |
yncnt2(1,i)=yncnt(i) |
125 |
ENDDO |
126 |
C |
127 |
dtmisd=1.0 |
128 |
dthxm=1.0 |
129 |
dthym=1.0 |
130 |
tmisd=0 |
131 |
thxm=0 |
132 |
thym=0 |
133 |
C |
134 |
c Iterative procedure starts here |
135 |
C |
136 |
DO it=1,4 |
137 |
C |
138 |
c Fit the CoEs with a linear function |
139 |
C |
140 |
CALL LEASTSQR(22,zx,xecnt,xwght,ax,bx,eax,ebx,chi2x,Nfitx) !<----- LINEAR FIT |
141 |
CALL LEASTSQR(22,zy,yecnt,ywght,ay,by,eay,eby,chi2y,Nfity) |
142 |
ax2(it)=ax |
143 |
ay2(it)=ay |
144 |
eax2(it)=eax |
145 |
eay2(it)=eay |
146 |
bx2(it)=bx |
147 |
by2(it)=by |
148 |
ebx2(it)=ebx |
149 |
eby2(it)=eby |
150 |
C |
151 |
c Calculate theta and phi |
152 |
C |
153 |
dtmisd=ABS(tmisd-ATAN(SQRT((bx*bx)+(by*by)))) |
154 |
dthxm=ABS(thxm-ABS(ATAN(bx))) |
155 |
dthym=ABS(thym-ABS(ATAN(by))) |
156 |
tmisd=ATAN(SQRT((bx*bx)+(by*by))) |
157 |
thxm=ABS(ATAN(bx)) |
158 |
thym=ABS(ATAN(by)) |
159 |
IF (bx.EQ.0..AND.by.GT.0.) pmisd = 90.*(PI/180.) |
160 |
IF (bx.EQ.0..AND.by.LT.0.) pmisd = 270.*(PI/180.) |
161 |
IF (by.EQ.0..AND.bx.GE.0.) pmisd = 0.*(PI/180.) |
162 |
IF (by.EQ.0..AND.bx.LT.0.) pmisd = 180.*(PI/180.) |
163 |
IF (by.NE.0..AND.bx.NE.0.) THEN |
164 |
pmid = ATAN(by/bx) |
165 |
IF (by.LT.0..AND.bx.GT.0.) pmisd = pmid + 360.*(PI/180.) |
166 |
IF (bx.LT.0.) pmisd = pmid + 180.*(PI/180.) |
167 |
IF (by.GT.0..AND.bx.GT.0.) pmisd = pmid |
168 |
ENDIF |
169 |
C |
170 |
c Calculate the position of the strip closest to the fitted line and |
171 |
c the CoE of 4 surrounding strips. |
172 |
C |
173 |
DO i=1,22 |
174 |
CALL POS2STRIP(1,i,ax+bx*zx(i),xncnt(i)) |
175 |
CALL POS2STRIP(2,i,ay+by*zy(i),yncnt(i)) |
176 |
IF (xncnt(i).GE.1.AND.xncnt(i).LE.96) THEN |
177 |
CALL ENCENT2(1,xncnt(i),i,4,xecnt(i),xwght(i)) |
178 |
ELSE |
179 |
xecnt(i)=-99. |
180 |
xwght(i)=1.0e5 |
181 |
ENDIF |
182 |
C |
183 |
IF (yncnt(i).GE.1.AND.yncnt(i).LE.96) THEN |
184 |
CALL ENCENT2(2,yncnt(i),i,4,yecnt(i),ywght(i)) |
185 |
ELSE |
186 |
yecnt(i)=-99. |
187 |
ywght(i)=1.0e5 |
188 |
ENDIF |
189 |
xncnt2(it+1,i)=xncnt(i) |
190 |
yncnt2(it+1,i)=yncnt(i) |
191 |
xecnt2(it+1,i)=xecnt(i) |
192 |
xwght2(it+1,i)=xwght(i) |
193 |
yecnt2(it+1,i)=yecnt(i) |
194 |
ywght2(it+1,i)=ywght(i) |
195 |
ENDDO |
196 |
C |
197 |
c Calculate at which plane the particle has entered the calorimeter |
198 |
c according to the fit |
199 |
C |
200 |
IF (bx.GT.0.) CALL POS2PLANE((calwidth/2)/bx-ax/bx,plentx) |
201 |
IF (bx.LT.0.) CALL POS2PLANE(-(calwidth/2)/bx-ax/bx,plentx) |
202 |
IF (bx.EQ.0.) plentx=1 |
203 |
IF (by.GT.0.) CALL POS2PLANE((calwidth/2)/by-ay/by,plenty) |
204 |
IF (by.LT.0.) CALL POS2PLANE(-(calwidth/2)/by-ay/by,plenty) |
205 |
IF (by.EQ.0.) plenty=1 |
206 |
plent=MAX(plentx,plenty) |
207 |
C |
208 |
c Calculate the projection in the bottom plane |
209 |
C |
210 |
qxp=ax+bx*ztopx |
211 |
qyp=ay+by*ztopy |
212 |
zetamx=ztopx-zbotx |
213 |
zetamy=ztopy-zboty |
214 |
C |
215 |
IF (qxp.GT.calwidth/2) THEN |
216 |
zetamx = zetamx-(qxp-calwidth/2)/bx |
217 |
qxp = calwidth/2 |
218 |
ENDIF |
219 |
IF (qxp.LT.-calwidth/2) THEN |
220 |
zetamx = zetamx-(qxp+calwidth/2)/bx |
221 |
qxp = -calwidth/2 |
222 |
ENDIF |
223 |
IF (qyp.GT.calwidth/2) THEN |
224 |
zetamy = zetamy-(qyp-calwidth/2)/by |
225 |
qyp = calwidth/2 |
226 |
ENDIF |
227 |
IF (qyp.LT.-calwidth/2) THEN |
228 |
zetamy = zetamy-(qyp+calwidth/2)/by |
229 |
qyp = -calwidth/2 |
230 |
ENDIF |
231 |
C |
232 |
posixmd = qxp - zetamx*TAN(tmisd)*COS(pmisd) |
233 |
posiymd = qyp - zetamy*TAN(tmisd)*SIN(pmisd) |
234 |
C |
235 |
c Energy correction |
236 |
C |
237 |
IF ((ABS(ax+bx*zbotx).LE.10.1).AND. |
238 |
& (ABS(ay+by*zboty).LE.10.1)) THEN |
239 |
ifin = finpar + 3 |
240 |
IF (ifin.GT.22) ifin = 22 |
241 |
ELSE |
242 |
ifin = finpar |
243 |
ENDIF |
244 |
|
245 |
parzen2 = 0.0 |
246 |
DO i=1,ifin |
247 |
parzen2=parzen2+parz(1,i)+parz(2,i) !Sum up energy until 'ifin' |
248 |
ENDDO |
249 |
|
250 |
fflaco = ifin-plent |
251 |
funcor2=parzen2/ENCORR(fflaco/COS(tmisd)) |
252 |
|
253 |
IF ((ABS(ax+bx*zbotx).LE.10.1).AND. |
254 |
& (ABS(ay+by*zboty).LE.10.1)) THEN |
255 |
parzen3 = funcor2*(1.-.01775-funcor2*(.2096E-4)+ |
256 |
& funcor2*funcor2*funcor2*(.2865E-9)) |
257 |
ELSE |
258 |
parzen3 = funcor2*(1.-.124+funcor2*(.24E-3)+ |
259 |
& funcor2*funcor2*funcor2*(.25E-9))/.7 |
260 |
ENDIF |
261 |
C |
262 |
c Angle correction |
263 |
C |
264 |
DO i=1,22 |
265 |
C |
266 |
c x view |
267 |
C |
268 |
IF (xecnt(i).GT.-97.) THEN |
269 |
IF (parzen3.GE.250.) THEN |
270 |
xcorr(i) = wcorr*CORRANG(FLOAT(i)/ffla,(thxm*180./PI)+ |
271 |
& (parzen3-250)*1.764705E-2) |
272 |
ELSE |
273 |
xcorr(i) = wcorr*CORRANG(FLOAT(i)/ffla,thxm*180./PI) |
274 |
ENDIF |
275 |
ELSE |
276 |
xcorr(i) = 0.0 |
277 |
ENDIF |
278 |
xecnt(i) = xecnt(i) + xcorr(i) |
279 |
C |
280 |
c y view |
281 |
C |
282 |
IF (yecnt(i).GT.-97.) THEN |
283 |
IF (parzen3.GE.250.) THEN |
284 |
ycorr(i) = wcorr*CORRANG(FLOAT(i)/ffla,thym*180./PI+ |
285 |
& (parzen3-250)*1.764705E-2) |
286 |
ELSE |
287 |
ycorr(i) = wcorr*CORRANG(FLOAT(i)/ffla,thym*180./PI) |
288 |
ENDIF |
289 |
ELSE |
290 |
ycorr(i) = 0.0 |
291 |
ENDIF |
292 |
yecnt(i) = yecnt(i) + ycorr(i) |
293 |
C |
294 |
xcorr2(it,i)=xcorr(i) |
295 |
ycorr2(it,i)=ycorr(i) |
296 |
C |
297 |
ENDDO |
298 |
C |
299 |
ENDDO |
300 |
C |
301 |
RETURN |
302 |
C |
303 |
END |
304 |
|
305 |
C |
306 |
C----------------------------------------------------------------------- |
307 |
SUBROUTINE ENCENT(view,nsmax,nplane,nit,ecnt,weight) |
308 |
c |
309 |
c Calculates the center of energy in a cluster |
310 |
c |
311 |
C----------------------------------------------------------------------- |
312 |
C |
313 |
IMPLICIT NONE |
314 |
C |
315 |
INCLUDE 'INTEST.TXT' |
316 |
C |
317 |
REAL ecnt,weight,esumw,esum,strip1,strip2,xypos,zpos,xymean, |
318 |
& xystd |
319 |
INTEGER nsmax,st0,st1,st2,st3,nplane,nit,view,npos,p |
320 |
C |
321 |
PARAMETER (strip1=17.,strip2=9.) |
322 |
C |
323 |
st0 = NINT(strip1) ! =17 cluster width for iteration 1 |
324 |
st1 = NINT(strip1-strip2) ! =8 |
325 |
st2 = NINT((strip1-1.)/2. + 1.) ! =9 cluster width for iteration 2 |
326 |
st3 = NINT(FLOAT(st1)/2.) ! =4 |
327 |
C |
328 |
IF (nsmax.GT.0.) THEN |
329 |
esumw = 0. |
330 |
esum = 0. |
331 |
xymean = 0. |
332 |
xystd = 0. |
333 |
DO P = 1, (st0-(nit-1)*st1) ! loop to 17(9) for iteration 1(2) |
334 |
C |
335 |
c Calculate strip number |
336 |
C |
337 |
IF (nsmax.LT.(st2-st3*(nit-1))) THEN ! if nsmax < 9(5) for iteration 1(2) |
338 |
npos = P |
339 |
IF (npos.GT.(st0-ABS(nsmax-st2-st3*(nit-1)))) |
340 |
& GO TO 7100 ! quit loop after the 8th(4th) strip to the right of nsmax for iteration 1(2) |
341 |
ELSE |
342 |
npos = nsmax+P-st2+st3*(nit-1) ! npos=nsmax-8,-7, ... +7,+8(nsmax-4,-3, ... +3,+4) for iteration 1(2) |
343 |
IF (npos.GT.96) |
344 |
& GO TO 7100 ! quit loop after the 96th strip |
345 |
ENDIF |
346 |
C |
347 |
c Get the position for npos |
348 |
C |
349 |
CALL STRIP2POS(view,nplane,npos,xypos,zpos) |
350 |
C |
351 |
c Sum up energies |
352 |
C |
353 |
esumw = esumw + xypos*DEXY(view,nplane,npos) |
354 |
esum = esum + DEXY(view,nplane,npos) |
355 |
ENDDO |
356 |
C |
357 |
7100 CONTINUE |
358 |
C |
359 |
c Calculate CoE and wieghts |
360 |
C |
361 |
IF (esum.GT.0.) THEN |
362 |
ecnt = esumw/esum |
363 |
weight = ecnt/(esum**.79) |
364 |
ELSE |
365 |
ecnt = -98. |
366 |
weight = 1E5 |
367 |
ENDIF |
368 |
ELSE |
369 |
ecnt = -97. |
370 |
weight = 1E5 |
371 |
ENDIF |
372 |
C |
373 |
RETURN |
374 |
C |
375 |
END |
376 |
C |
377 |
C----------------------------------------------------------------------- |
378 |
SUBROUTINE ENCENT2(view,nsmax,nplane,width,ecnt,weight) |
379 |
C----------------------------------------------------------------------- |
380 |
C |
381 |
IMPLICIT NONE |
382 |
C |
383 |
INCLUDE 'INTEST.TXT' |
384 |
C |
385 |
INTEGER i,nplane,view,nsmax,width,nrec |
386 |
REAL mx,mx2,s1,s2,xypos,ecnt,weight,zpos |
387 |
C |
388 |
mx=0.0 |
389 |
mx2=0.0 |
390 |
s2=0.0 |
391 |
nrec=0 |
392 |
DO i=nsmax-width,nsmax+width |
393 |
C |
394 |
IF(i.GT.0.AND.i.LT.97.AND.DEXY(view,nplane,i).GT.0.0) THEN |
395 |
C |
396 |
nrec=nrec+1 |
397 |
C |
398 |
CALL STRIP2POS(view,nplane,i,xypos,zpos) |
399 |
C |
400 |
s1=s2 |
401 |
s2=s2+DEXY(view,nplane,i) |
402 |
mx=(mx*s1+xypos*DEXY(view,nplane,i))/s2 |
403 |
mx2=(mx2*s1+(xypos**2)*DEXY(view,nplane,i))/s2 |
404 |
C |
405 |
ENDIF |
406 |
C |
407 |
ENDDO |
408 |
C |
409 |
IF (nrec.GT.0) THEN |
410 |
ecnt=mx |
411 |
IF (nrec.EQ.1) weight=0.244/sqrt(12*s2) |
412 |
IF (nrec.NE.1) weight=sqrt(mx2-mx**2)/sqrt(s2) |
413 |
ELSE |
414 |
ecnt=-99.0 |
415 |
weight=100000.0 |
416 |
ENDIF |
417 |
C |
418 |
RETURN |
419 |
C |
420 |
END |
421 |
|
422 |
C--------------------------------------------------------------------------- |
423 |
SUBROUTINE POS2PLANE(pos,plane) |
424 |
c |
425 |
c Find the plane closest to a certain z position |
426 |
C--------------------------------------------------------------------------- |
427 |
|
428 |
IMPLICIT NONE |
429 |
|
430 |
REAL pos, npos, pdiff, xy |
431 |
INTEGER view, plane, nplane |
432 |
|
433 |
pdiff=1000. |
434 |
plane=1 |
435 |
DO view=1,2 |
436 |
DO nplane=1,22 |
437 |
CALL STRIP2POS(view,nplane,1,xy,npos) |
438 |
IF (ABS(pos-npos).LT.pdiff) THEN |
439 |
pdiff=ABS(pos-npos) |
440 |
plane=nplane |
441 |
ENDIF |
442 |
ENDDO |
443 |
ENDDO |
444 |
C |
445 |
RETURN |
446 |
C |
447 |
END |
448 |
|
449 |
C--------------------------------------------------------------------------- |
450 |
SUBROUTINE POS2STRIP(view,nplane,pos,strip) |
451 |
c |
452 |
c Find the strip closest to a certain x or y position |
453 |
C--------------------------------------------------------------------------- |
454 |
C |
455 |
IMPLICIT NONE |
456 |
C |
457 |
REAL pos, npos, minpos, maxpos, pdiff, z |
458 |
INTEGER view, nplane, strip, i |
459 |
C |
460 |
pdiff=1000. |
461 |
strip=-1 |
462 |
CALL STRIP2POS(view,nplane,1,minpos,z) |
463 |
CALL STRIP2POS(view,nplane,96,maxpos,z) |
464 |
IF (pos.LT.minpos) THEN |
465 |
strip=0 |
466 |
ELSEIF (pos.GT.maxpos) THEN |
467 |
strip=97 |
468 |
ELSE |
469 |
DO i=1,96 |
470 |
CALL STRIP2POS(view,nplane,i,npos,z) |
471 |
IF (ABS(pos-npos).LT.pdiff) THEN |
472 |
pdiff=ABS(pos-npos) |
473 |
strip=i |
474 |
ENDIF |
475 |
ENDDO |
476 |
ENDIF |
477 |
C |
478 |
RETURN |
479 |
C |
480 |
END |
481 |
|
482 |
C--------------------------------------------------------------------- |
483 |
SUBROUTINE STRIP2POS(view,nplane,nstrip,xy,z) |
484 |
c |
485 |
c Calculates the x (or y) and z position of a strip in PAMELA coordinates |
486 |
c |
487 |
c Arguments |
488 |
c --------- |
489 |
c view: x=1 and y=2 |
490 |
c nplane: plane number 1-22 |
491 |
c nstrip: strip number 1-96 |
492 |
c |
493 |
c Return values |
494 |
c ------------- |
495 |
c xy: x or y position of the strip-center in PAMELA coordinates |
496 |
c z: z position of the plane in PMAELA coordinates |
497 |
C--------------------------------------------------------------------- |
498 |
|
499 |
IMPLICIT NONE |
500 |
|
501 |
INTEGER view,isy,iseven,nplane,nstrip,nwaf,wstr,npl |
502 |
REAL wpos,pos,x,y,z,xy |
503 |
|
504 |
c Calculate the x- or y-position in a plane |
505 |
|
506 |
nwaf=int((nstrip-1)/32) !what wafer (0-2) |
507 |
wstr=mod(nstrip-1,32) !what strip in the wafer (0-31) |
508 |
wpos=0.096+0.122+wstr*0.244 !the position of the strip center in the wafer |
509 |
c pos=wpos+nwaf*8.0005-12.0005 !the position in the plane (oigo shifted to center of plane) |
510 |
pos=wpos+nwaf*8.0505-12.0005 !the position in the plane (oigo shifted to center of plane) |
511 |
|
512 |
c Calculate z position and add x-y-offset depending on the plane number |
513 |
|
514 |
isy=view-1 !isy=0 for x and 1 for y |
515 |
iseven=mod(nplane,2)! iseven=0 for odd and 1 for even planes |
516 |
npl=nplane-1 |
517 |
IF (isy.EQ.0) THEN |
518 |
IF (iseven.EQ.0) THEN |
519 |
c print *,'CALCULATING X-ODD' |
520 |
x = pos+0.05 !x-odd |
521 |
y = pos-0.2 |
522 |
z = -26.762-0.809*npl-0.2*(npl-1)/2 |
523 |
ELSE |
524 |
c print *,'CALCULATING X-EVEN' |
525 |
x = pos-0.05 !x-even |
526 |
y = pos+0.0 |
527 |
z = -26.762-0.809*npl-0.2*npl/2 |
528 |
ENDIF |
529 |
xy=x |
530 |
ELSE |
531 |
IF (iseven.EQ.0) THEN |
532 |
c print *,'CALCULATING Y-ODD' |
533 |
x = pos-0.1 ! y-odd |
534 |
y = pos-0.15 |
535 |
z = -26.181-0.809*npl-0.2*(npl-1)/2 |
536 |
ELSE |
537 |
c print *,'CALCULATING Y-EVEN' |
538 |
x = pos+0.1 ! y-even |
539 |
y = pos-0.05 |
540 |
z = -26.181-0.809*npl-0.2*npl/2 |
541 |
ENDIF |
542 |
xy=y |
543 |
ENDIF |
544 |
C |
545 |
RETURN |
546 |
END |
547 |
|
548 |
C--------------------------------------------------------------------------- |
549 |
SUBROUTINE LEASTSQR(N,x,y,sy,a,b,ea,eb,chi2,Nfit) |
550 |
c |
551 |
c Linear least square fit (method is described in "Taylor" chapter 8) |
552 |
c |
553 |
c |
554 |
c |
555 |
C--------------------------------------------------------------------------- |
556 |
C |
557 |
INTEGER N,Nfit |
558 |
REAL x(N),y(N),sy(N),w(N),Swx2,Swx,Swy,Swxy,Sw,a,b,ea,eb,chi2 |
559 |
C |
560 |
Swx2=0 |
561 |
Swx=0 |
562 |
Swy=0 |
563 |
Swxy=0 |
564 |
Sw=0 |
565 |
Nfit=0 |
566 |
DO i=1,N |
567 |
IF (y(i).GT.-97.) THEN |
568 |
Nfit=Nfit+1 |
569 |
w(i)=1/(sy(i)**2) ! the weight |
570 |
Swx2=Swx2+w(i)*(x(i)**2)! some sums |
571 |
Swx=Swx+w(i)*x(i) |
572 |
Swy=Swy+w(i)*y(i) |
573 |
Swxy=Swxy+w(i)*x(i)*y(i) |
574 |
Sw=Sw+w(i) |
575 |
c print *,'FIT LOOP:',sy(i),w(i),x(i),y(i),Swx2,Swx,Swy,Swxy,Sw |
576 |
ENDIF |
577 |
ENDDO |
578 |
|
579 |
delta=Sw*Swx2-(Swx**2) |
580 |
a=(Swx2*Swy-Swx*Swxy)/delta ! offset |
581 |
b=(Sw*Swxy-Swx*Swy)/delta ! slope |
582 |
ea=sqrt(Swx2/delta) ! offset standard deviation |
583 |
eb=sqrt(Sw/delta) ! slope standard deviation |
584 |
|
585 |
chi2=0.0 |
586 |
DO i=1,N |
587 |
IF (y(i).GT.-97.) THEN |
588 |
chi2=chi2+((a+b*x(i))-y(i))**2/sy(i)**2 |
589 |
ENDIF |
590 |
ENDDO |
591 |
|
592 |
c print *,'FIT RESULT:',a,b,chi2,Nfit |
593 |
RETURN |
594 |
END |
595 |
|
596 |
C--------------------------------------------------------------------------- |
597 |
REAL FUNCTION ENCORR(X) |
598 |
C--------------------------------------------------------------------------- |
599 |
|
600 |
REAL FFUN |
601 |
PARAMETER (CALIB=0.0001059994) |
602 |
PARAMETER (P1=.8993962E-2) |
603 |
PARAMETER (P2=-.449717) |
604 |
PARAMETER (P3=10.90797) |
605 |
PARAMETER (P4=-.6768349E-2) |
606 |
|
607 |
|
608 |
FFUN = P1 + P4 * ATAN((X - P3) * P2) |
609 |
|
610 |
IF (FFUN.EQ.0.) THEN |
611 |
FFUN = 1.E-10 |
612 |
ENDIF |
613 |
|
614 |
ENCORR = FFUN/CALIB |
615 |
|
616 |
RETURN |
617 |
END |
618 |
|
619 |
C--------------------------------------------------------------------------- |
620 |
REAL FUNCTION CORRANG(X,ANGX) |
621 |
C--------------------------------------------------------------------------- |
622 |
|
623 |
REAL A,B,X,ANGX |
624 |
|
625 |
A = -0.017695 + ANGX * 0.0016963 |
626 |
B = -0.049583 + ANGX * 0.0050639 |
627 |
CORRANG = 0. |
628 |
IF (X.LE..9) CORRANG = A * (X - .9) |
629 |
IF (X.GE..9.AND.X.LE.1.1) CORRANG = 0. |
630 |
IF (X.GE.1.1) CORRANG = B * (X - 1.1) |
631 |
IF (ANGX.LT.10.) CORRANG = 0. |
632 |
|
633 |
RETURN |
634 |
END |
635 |
|