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