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