/[PAMELA software]/DarthVader/CalorimeterLevel2/src/selftrig.for
ViewVC logotype

Contents of /DarthVader/CalorimeterLevel2/src/selftrig.for

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations) (download)
Fri Jul 20 08:24:55 2007 UTC (17 years, 4 months ago) by mocchiut
Branch: MAIN
CVS Tags: v5r00, v4r00
Changes since 1.3: +27 -24 lines
Formal changes to use fortran routines in the presampler analysis

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

  ViewVC Help
Powered by ViewVC 1.1.23