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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide annotations) (download)
Fri Mar 30 11:17:17 2007 UTC (17 years, 8 months ago) by mocchiut
Branch: MAIN
CVS Tags: v3r04, v3r05, v3r06, v3r03
Changes since 1.2: +25 -21 lines
Shift inversion on X views bug fixed

1 mocchiut 1.1 C
2 mocchiut 1.3 C
3     C NOTE: THIS ROUTINE DOES NOT SEEMS TO WORK CORRECTLY, HAS TO BE CHECKED CAREFULLY
4     C
5     C
6 mocchiut 1.1 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 mocchiut 1.2 CC PARAMETER (calwidth=24.2)
20     PARAMETER (calwidth=24.1)
21 mocchiut 1.1 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 mocchiut 1.3 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 mocchiut 1.1 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 mocchiut 1.3 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 mocchiut 1.1 xncnt(i)=j+1
98     ENDIF
99 mocchiut 1.3 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 mocchiut 1.1 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 mocchiut 1.3 esumw = esumw + xypos*DEXY(view,nplane,npos)
354     esum = esum + DEXY(view,nplane,npos)
355 mocchiut 1.1 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 mocchiut 1.3 IF(i.GT.0.AND.i.LT.97.AND.DEXY(view,nplane,i).GT.0.0) THEN
395 mocchiut 1.1 C
396     nrec=nrec+1
397     C
398     CALL STRIP2POS(view,nplane,i,xypos,zpos)
399     C
400     s1=s2
401 mocchiut 1.3 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 mocchiut 1.1 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 mocchiut 1.2 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 mocchiut 1.1
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    

  ViewVC Help
Powered by ViewVC 1.1.23