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

  ViewVC Help
Powered by ViewVC 1.1.23