/[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.2 - (hide annotations) (download)
Tue Jan 16 11:06:05 2007 UTC (17 years, 10 months ago) by mocchiut
Branch: MAIN
CVS Tags: v3r00
Changes since 1.1: +4 -2 lines
Small dimension bug in selftrig.for fixed

1 mocchiut 1.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 mocchiut 1.2 CC PARAMETER (calwidth=24.2)
16     PARAMETER (calwidth=24.1)
17 mocchiut 1.1 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 mocchiut 1.2 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 mocchiut 1.1
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    

  ViewVC Help
Powered by ViewVC 1.1.23