/[PAMELA software]/DarthVader/TrackerLevel2/src/F77/functionspfa.f
ViewVC logotype

Annotation of /DarthVader/TrackerLevel2/src/F77/functionspfa.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.18 - (hide annotations) (download)
Mon Aug 20 16:07:16 2007 UTC (17 years, 3 months ago) by pam-fi
Branch: MAIN
Changes since 1.17: +9 -9 lines
missing-image bug fixed + other changes

1 pam-fi 1.9
2 pam-fi 1.10
3     subroutine idtoc(ipfa,cpfa)
4    
5     integer ipfa
6 pam-fi 1.18 character*10 cpfa
7 pam-fi 1.10
8     CPFA='COG4'
9     if(ipfa.eq.0)CPFA='ETA'
10     if(ipfa.eq.2)CPFA='ETA2'
11     if(ipfa.eq.3)CPFA='ETA3'
12     if(ipfa.eq.4)CPFA='ETA4'
13 pam-fi 1.16 if(ipfa.eq.5)CPFA='ETAL'
14 pam-fi 1.10 if(ipfa.eq.10)CPFA='COG'
15     if(ipfa.eq.11)CPFA='COG1'
16     if(ipfa.eq.12)CPFA='COG2'
17     if(ipfa.eq.13)CPFA='COG3'
18     if(ipfa.eq.14)CPFA='COG4'
19    
20     end
21    
22 mocchiut 1.1 *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
23     * this file contains all subroutines and functions
24     * that are needed for position finding algorithms
25     *
26     *
27     *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
28    
29    
30 pam-fi 1.9 integer function npfastrips(ic,PFA,angle)
31     *--------------------------------------------------------------
32     * thid function returns the number of strips used
33     * to evaluate the position of a cluster, according to the p.f.a.
34     *--------------------------------------------------------------
35     include 'commontracker.f'
36     include 'level1.f'
37     include 'calib.f'
38    
39     character*4 usedPFA,PFA
40    
41    
42     usedPFA=PFA
43    
44     npfastrips=0
45    
46     if(usedPFA.eq.'COG1')npfastrips=1
47     if(usedPFA.eq.'COG2')npfastrips=2
48     if(usedPFA.eq.'COG3')npfastrips=3
49     if(usedPFA.eq.'COG4')npfastrips=4
50     if(usedPFA.eq.'ETA2')npfastrips=2
51     if(usedPFA.eq.'ETA3')npfastrips=3
52     if(usedPFA.eq.'ETA4')npfastrips=4
53     * ----------------------------------------------------------------
54     if(usedPFA.eq.'ETA')then
55     c print*,VIEW(ic),angle
56     if(mod(int(VIEW(ic)),2).eq.1)then !Y-view
57     if( abs(angle).ge.e2fay.and.abs(angle).lt.e2tay )then
58     npfastrips=2
59     elseif( abs(angle).ge.e3fay.and.abs(angle).lt.e3tay )then
60     npfastrips=3
61     elseif( abs(angle).ge.e4fay.and.abs(angle).lt.e4tay )then
62     npfastrips=4
63     else
64     npfastrips=4
65     c usedPFA='COG'
66     endif
67     else !X-view
68     if( abs(angle).ge.e2fax.and.abs(angle).lt.e2tax )then
69     npfastrips=2
70     elseif( abs(angle).ge.e3fax.and.abs(angle).lt.e3tax )then
71     npfastrips=3
72     elseif( abs(angle).ge.e4fax.and.abs(angle).lt.e4tax )then
73     npfastrips=4
74     else
75     npfastrips=4
76     c usedPFA='COG'
77     endif
78     endif
79     endif
80     * ----------------------------------------------------------------
81     if(usedPFA.eq.'COG')then
82    
83     iv=VIEW(ic)
84     if(mod(iv,2).eq.1)incut=incuty
85     if(mod(iv,2).eq.0)incut=incutx
86     istart = INDSTART(IC)
87     istop = TOTCLLENGTH
88     if(ic.lt.NCLSTR1)istop=INDSTART(IC+1)-1
89     mu = 0
90     do i = INDMAX(IC),istart,-1
91     ipos = i-INDMAX(ic)
92     cut = incut*CLSIGMA(i)
93     if(CLSIGNAL(i).ge.cut)then
94     mu = mu + 1
95     print*,i,mu
96     else
97     goto 10
98     endif
99     enddo
100     10 continue
101     do i = INDMAX(IC)+1,istop
102     ipos = i-INDMAX(ic)
103     cut = incut*CLSIGMA(i)
104     if(CLSIGNAL(i).ge.cut)then
105     mu = mu + 1
106     print*,i,mu
107     else
108     goto 20
109     endif
110     enddo
111     20 continue
112     npfastrips=mu
113    
114     endif
115     * ----------------------------------------------------------------
116    
117     c print*,pfastrips
118    
119     return
120     end
121    
122 mocchiut 1.1 *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
123 pam-fi 1.4 real function pfaeta(ic,angle)
124 mocchiut 1.1 *--------------------------------------------------------------
125     * this function returns the position (in strip units)
126     * it calls:
127 pam-fi 1.4 * - pfaeta2(ic,angle)
128     * - pfaeta3(ic,angle)
129     * - pfaeta4(ic,angle)
130 mocchiut 1.1 * according to the angle
131     *--------------------------------------------------------------
132     include 'commontracker.f'
133     include 'level1.f'
134 pam-fi 1.9 include 'calib.f'
135 mocchiut 1.1
136 pam-fi 1.4 pfaeta = 0
137 mocchiut 1.1
138     if(mod(int(VIEW(ic)),2).eq.1)then !Y-view
139    
140 pam-fi 1.9 if( abs(angle).ge.e2fay.and.abs(angle).le.e2tay )then
141     pfaeta = pfaeta2(ic,angle)
142     elseif( abs(angle).ge.e3fay.and.abs(angle).le.e3tay )then
143     pfaeta = pfaeta3(ic,angle)
144     elseif( abs(angle).ge.e4fay.and.abs(angle).le.e4tay )then
145     pfaeta = pfaeta4(ic,angle)
146     else
147     pfaeta = cog(4,ic)
148     endif
149    
150 mocchiut 1.1 else !X-view
151    
152 pam-fi 1.9 if( abs(angle).ge.e2fax.and.abs(angle).le.e2tax )then
153 pam-fi 1.4 pfaeta = pfaeta2(ic,angle)
154 pam-fi 1.9 elseif( abs(angle).ge.e3fax.and.abs(angle).le.e3tax )then
155 pam-fi 1.4 pfaeta = pfaeta3(ic,angle)
156 pam-fi 1.9 elseif( abs(angle).ge.e4fax.and.abs(angle).le.e4tax )then
157 pam-fi 1.4 pfaeta = pfaeta4(ic,angle)
158 pam-fi 1.9 else
159     pfaeta = cog(4,ic)
160     endif
161 mocchiut 1.1
162     endif
163 pam-fi 1.5
164 mocchiut 1.1 100 return
165     end
166    
167     *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
168 pam-fi 1.16 real function pfaetal(ic,angle)
169     *--------------------------------------------------------------
170     * this function returns the position (in strip units)
171     * it calls:
172     * - pfaeta2(ic,angle)+pfcorr(ic,angle)
173     * - pfaeta3(ic,angle)+pfcorr(ic,angle)
174     * - pfaeta4(ic,angle)+pfcorr(ic,angle)
175     * according to the angle
176     *--------------------------------------------------------------
177     include 'commontracker.f'
178     include 'level1.f'
179     include 'calib.f'
180    
181     pfaeta = 0
182    
183     if(mod(int(VIEW(ic)),2).eq.1)then !Y-view
184    
185     if( abs(angle).ge.e2fay.and.abs(angle).le.e2tay )then
186 pam-fi 1.17 pfaeta = pfaeta2(ic,angle)+pfacorr(ic,angle)
187 pam-fi 1.16 elseif( abs(angle).ge.e3fay.and.abs(angle).le.e3tay )then
188 pam-fi 1.17 pfaeta = pfaeta3(ic,angle)+pfacorr(ic,angle)
189 pam-fi 1.16 elseif( abs(angle).ge.e4fay.and.abs(angle).le.e4tay )then
190 pam-fi 1.17 pfaeta = pfaeta4(ic,angle)+pfacorr(ic,angle)
191 pam-fi 1.16 else
192     pfaeta = cog(4,ic)
193     endif
194    
195     else !X-view
196    
197     if( abs(angle).ge.e2fax.and.abs(angle).le.e2tax )then
198 pam-fi 1.17 pfaeta = pfaeta2(ic,angle)+pfacorr(ic,angle)
199 pam-fi 1.16 elseif( abs(angle).ge.e3fax.and.abs(angle).le.e3tax )then
200 pam-fi 1.17 pfaeta = pfaeta3(ic,angle)+pfacorr(ic,angle)
201 pam-fi 1.16 elseif( abs(angle).ge.e4fax.and.abs(angle).le.e4tax )then
202 pam-fi 1.17 pfaeta = pfaeta4(ic,angle)+pfacorr(ic,angle)
203 pam-fi 1.16 else
204     pfaeta = cog(4,ic)
205     endif
206    
207     endif
208    
209     100 return
210     end
211     *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
212 pam-fi 1.11 c real function riseta(ic,angle)
213     real function riseta(iview,angle)
214 mocchiut 1.1 *--------------------------------------------------------------
215     * this function returns the average spatial resolution
216 pam-fi 1.4 * (in cm) for the ETA algorithm (function pfaeta(ic,angle))
217 mocchiut 1.1 * it calls:
218 pam-fi 1.13 * - risxeta2(angle)
219     * - risyeta2(angle)
220     * - risxeta3(angle)
221     * - risxeta4(angle)
222 mocchiut 1.1 * according to the angle
223     *--------------------------------------------------------------
224     include 'commontracker.f'
225     include 'level1.f'
226 pam-fi 1.9 include 'calib.f'
227 mocchiut 1.1
228 pam-fi 1.11 riseta = 0
229 mocchiut 1.1
230 pam-fi 1.11 c if(mod(int(VIEW(ic)),2).eq.1)then !Y-view
231     if(mod(iview,2).eq.1)then !Y-view
232 mocchiut 1.1
233 pam-fi 1.9
234     if( abs(angle).ge.e2fay.and.abs(angle).le.e2tay )then
235 pam-fi 1.13 riseta = risyeta2(angle)
236 pam-fi 1.9 elseif( abs(angle).ge.e3fay.and.abs(angle).le.e3tay )then
237 pam-fi 1.11 riseta = risy_cog(angle) !ATTENZIONE!!
238 pam-fi 1.9 elseif( abs(angle).ge.e4fay.and.abs(angle).le.e4tay )then
239 pam-fi 1.11 riseta = risy_cog(angle) !ATTENZIONE!!
240 pam-fi 1.9 else
241 pam-fi 1.11 riseta = risy_cog(angle)
242 pam-fi 1.9 endif
243 mocchiut 1.1
244     else !X-view
245    
246 pam-fi 1.9 if( abs(angle).ge.e2fax.and.abs(angle).le.e2tax )then
247 pam-fi 1.13 riseta = risxeta2(angle)
248 pam-fi 1.9 elseif( abs(angle).ge.e3fax.and.abs(angle).le.e3tax )then
249 pam-fi 1.13 riseta = risxeta3(angle)
250 pam-fi 1.9 elseif( abs(angle).ge.e4fax.and.abs(angle).le.e4tax )then
251 pam-fi 1.13 riseta = risxeta4(angle)
252 pam-fi 1.9 else
253 pam-fi 1.11 riseta = risx_cog(angle)
254 pam-fi 1.9 endif
255 mocchiut 1.1
256     endif
257    
258 pam-fi 1.11
259 mocchiut 1.1 100 return
260     end
261    
262     *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
263     real function fbad_eta(ic,angle)
264     *-------------------------------------------------------
265     * this function returns a factor that takes into
266     * account deterioration of the spatial resolution
267     * in the case BAD strips are included in the cluster.
268     * This factor should multiply the nominal spatial
269     * resolution.
270     * It calls the function FBAD_COG(NCOG,IC),
271     * accordingto the angle
272     *-------------------------------------------------------
273    
274     include 'commontracker.f'
275     include 'level1.f'
276 pam-fi 1.9 include 'calib.f'
277 mocchiut 1.1 fbad_eta = 0
278    
279     if(mod(int(VIEW(ic)),2).eq.1)then !Y-view
280    
281 pam-fi 1.9 if( abs(angle).ge.e2fay.and.abs(angle).le.e2tay )then
282     fbad_eta = fbad_cog(2,ic)
283     elseif( abs(angle).ge.e3fay.and.abs(angle).le.e3tay )then
284     fbad_eta = fbad_cog(3,ic)
285     elseif( abs(angle).ge.e4fay.and.abs(angle).le.e4tay )then
286     fbad_eta = fbad_cog(4,ic)
287     else
288     fbad_eta = fbad_cog(4,ic)
289     endif
290 mocchiut 1.1
291     else !X-view
292    
293 pam-fi 1.9 if( abs(angle).ge.e2fax.and.abs(angle).le.e2tax )then
294 mocchiut 1.1 fbad_eta = fbad_cog(2,ic)
295 pam-fi 1.9 elseif( abs(angle).ge.e3fax.and.abs(angle).le.e3tax )then
296 mocchiut 1.1 fbad_eta = fbad_cog(3,ic)
297 pam-fi 1.9 elseif( abs(angle).ge.e4fax.and.abs(angle).le.e4tax )then
298     fbad_eta = fbad_cog(4,ic)
299     else
300 mocchiut 1.1 fbad_eta = fbad_cog(4,ic)
301 pam-fi 1.9 endif
302 mocchiut 1.1
303     endif
304    
305     return
306     end
307    
308     *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
309 pam-fi 1.4 real function pfaeta2(ic,angle) !(1)
310 mocchiut 1.1 *--------------------------------------------------------------
311     * this function returns
312     *
313     * - the position (in strip units)
314     * corrected according to the ETA2 Position Finding Algorithm.
315     * The function performs an interpolation of FETA2%ETA2
316     *
317     * - if the angle is out of range, the calibration parameters
318     * of the lowest or higher bin are used
319     *
320     *--------------------------------------------------------------
321     include 'commontracker.f'
322     include 'calib.f'
323     include 'level1.f'
324    
325     real cog2,angle
326     integer iview,lad
327    
328 pam-fi 1.9 iview = VIEW(ic)
329     lad = nld(MAXS(ic),VIEW(ic))
330     cog2 = cog(2,ic)
331 pam-fi 1.4 pfaeta2=cog2
332 mocchiut 1.1
333     * find angular bin
334     * (in futuro possiamo pensare di interpolare anche sull'angolo)
335     do iang=1,nangbin
336     if(angL(iang).lt.angle.and.angR(iang).ge.angle)then
337     iangle=iang
338     goto 98
339     endif
340     enddo
341 pam-fi 1.18 if(DEBUG.EQ.1)
342 pam-fi 1.4 $ print*,'pfaeta2 *** warning *** angle out of range: ',angle
343 mocchiut 1.1 if(angle.lt.angL(1))iang=1
344     if(angle.gt.angR(nangbin))iang=nangbin
345     98 continue !jump here if ok
346    
347    
348     c$$$* find extremes of interpolation
349     c$$$ iflag=0
350     c$$$* --------------------------------
351     c$$$ if(cog2.lt.eta2(1,iang).or.cog2.gt.eta2(netaval,iang))then
352 pam-fi 1.4 c$$$c print*,'pfaeta2 *** warning *** argument out of range: ',cog2
353 mocchiut 1.1 c$$$* goto 100
354     c$$$* ----------------------------------------------
355     c$$$* non salto piu`, ma scalo di 1 o -1
356     c$$$* nel caso si tratti di un cluster
357     c$$$* in cui la strip con il segnale massimo non coincide
358     c$$$* con la strip con il rapposto s/n massimo!!!
359     c$$$* ----------------------------------------------
360     c$$$ if(cog2.lt.eta2(1,iang))then !temp
361     c$$$ cog2=cog2+1. !temp
362     c$$$ iflag=1 !temp
363     c$$$ else !temp
364     c$$$ cog2=cog2-1. !temp
365     c$$$ iflag=-1 !temp
366     c$$$ endif !temp
367     c$$$c print*,'shifted >>> ',cog2
368     c$$$ endif
369    
370     iadd=0
371     10 continue
372     if(cog2.lt.eta2(1,iang))then
373     cog2 = cog2 + 1
374     iadd = iadd + 1
375     goto 10
376     endif
377     20 continue
378     if(cog2.gt.eta2(netaval,iang))then
379     cog2 = cog2 - 1
380     iadd = iadd - 1
381     goto 20
382     endif
383    
384     * --------------------------------
385     c print*,'*****',i,view,lad,iang,'------> cog2 ',cog2
386     do i=2,netaval
387     if(eta2(i,iang).gt.cog2)then
388    
389     x1 = eta2(i-1,iang)
390     x2 = eta2(i,iang)
391     y1 = feta2(i-1,iview,lad,iang)
392     y2 = feta2(i,iview,lad,iang)
393    
394     c print*,'*****',i,view,lad,iang
395     c print*,'-----',x1,x2,y1,y2
396     goto 99
397     endif
398     enddo
399     99 continue
400    
401    
402     AA=(y2-y1)/(x2-x1)
403     BB=y1-AA*x1
404    
405 pam-fi 1.4 pfaeta2 = AA*cog2+BB
406     pfaeta2 = pfaeta2 - iadd
407 mocchiut 1.1
408     c$$$ if(iflag.eq.1)then
409 pam-fi 1.4 c$$$ pfaeta2=pfaeta2-1. !temp
410 mocchiut 1.1 c$$$ cog2=cog2-1. !temp
411     c$$$ endif
412     c$$$ if(iflag.eq.-1)then
413 pam-fi 1.4 c$$$ pfaeta2=pfaeta2+1. !temp
414 mocchiut 1.1 c$$$ cog2=cog2+1. !temp
415     c$$$ endif
416    
417 pam-fi 1.18 if(DEBUG.EQ.1)print*,'ETA2 (ic ',ic,' ang',angle,')'
418 pam-fi 1.4 $ ,cog2-iadd,' -->',pfaeta2
419 mocchiut 1.1
420    
421     100 return
422     end
423    
424     *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
425 pam-fi 1.4 real function pfaeta3(ic,angle) !(1)
426 mocchiut 1.1 *--------------------------------------------------------------
427     * this function returns
428     *
429     * - the position (in strip units)
430     * corrected according to the ETA3 Position Finding Algorithm.
431     * The function performs an interpolation of FETA3%ETA3
432     *
433     * - if the angle is out of range, the calibration parameters
434     * of the lowest or higher bin are used
435     *
436     *--------------------------------------------------------------
437     include 'commontracker.f'
438     include 'calib.f'
439     include 'level1.f'
440    
441     real cog3,angle
442     integer iview,lad
443    
444    
445 pam-fi 1.9 iview = VIEW(ic)
446     lad = nld(MAXS(ic),VIEW(ic))
447     cog3 = cog(3,ic)
448 pam-fi 1.4 pfaeta3=cog3
449 mocchiut 1.1
450     * find angular bin
451     * (in futuro possiamo pensare di interpolare anche sull'angolo)
452     do iang=1,nangbin
453     c print*,'~~~~~~~~~~~~ ',iang,angL(iang),angR(iang),angle
454     if(angL(iang).lt.angle.and.angR(iang).ge.angle)then
455     iangle=iang
456     goto 98
457     endif
458     enddo
459 pam-fi 1.18 if(DEBUG.EQ.1)
460 pam-fi 1.4 $ print*,'pfaeta3 *** warning *** angle out of range: ',angle
461 mocchiut 1.1 if(angle.lt.angL(1))iang=1
462     if(angle.gt.angR(nangbin))iang=nangbin
463     98 continue !jump here if ok
464    
465    
466     c$$$* find extremes of interpolation
467     c$$$ iflag=0
468     c$$$* --------------------------------
469     c$$$ if(cog3.lt.eta3(1,iang).or.cog3.gt.eta3(netaval,iang))then
470     c$$$* ----------------------------------------------
471     c$$$* non salto piu`, ma scalo di 1 o -1
472     c$$$* nel caso si tratti di un cluster
473     c$$$* in cui la strip con il segnale massimo non coincide
474     c$$$* con la strip con il rapposto s/n massimo!!!
475     c$$$* ----------------------------------------------
476     c$$$ if(cog2.lt.eta2(1,iang))then !temp
477     c$$$ cog2=cog2+1. !temp
478     c$$$ iflag=1 !temp
479     c$$$ else !temp
480     c$$$ cog2=cog2-1. !temp
481     c$$$ iflag=-1 !temp
482     c$$$ endif !temp
483     c$$$c print*,'shifted >>> ',cog2
484     c$$$ endif
485    
486    
487     iadd=0
488     10 continue
489     if(cog3.lt.eta3(1,iang))then
490     cog3 = cog3 + 1
491     iadd = iadd + 1
492     goto 10
493     endif
494     20 continue
495     if(cog3.gt.eta3(netaval,iang))then
496     cog3 = cog3 - 1
497     iadd = iadd - 1
498     goto 20
499     endif
500    
501     * --------------------------------
502     c print*,'*****',i,view,lad,iang,'------> cog2 ',cog2
503     do i=2,netaval
504     if(eta3(i,iang).gt.cog3)then
505    
506     x1 = eta3(i-1,iang)
507     x2 = eta3(i,iang)
508     y1 = feta3(i-1,iview,lad,iang)
509     y2 = feta3(i,iview,lad,iang)
510    
511     c print*,'*****',i,view,lad,iang
512     c print*,'-----',x1,x2,y1,y2
513     goto 99
514     endif
515     enddo
516     99 continue
517    
518    
519     AA=(y2-y1)/(x2-x1)
520     BB=y1-AA*x1
521    
522 pam-fi 1.4 pfaeta3 = AA*cog3+BB
523     pfaeta3 = pfaeta3 - iadd
524 mocchiut 1.1
525     c$$$ if(iflag.eq.1)then
526 pam-fi 1.4 c$$$ pfaeta2=pfaeta2-1. !temp
527 mocchiut 1.1 c$$$ cog2=cog2-1. !temp
528     c$$$ endif
529     c$$$ if(iflag.eq.-1)then
530 pam-fi 1.4 c$$$ pfaeta2=pfaeta2+1. !temp
531 mocchiut 1.1 c$$$ cog2=cog2+1. !temp
532     c$$$ endif
533    
534 pam-fi 1.18 if(DEBUG.EQ.1)print*,'ETA3 (ic ',ic,' ang',angle,')'
535 pam-fi 1.4 $ ,cog3-iadd,' -->',pfaeta3
536 mocchiut 1.1
537     100 return
538     end
539    
540     *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
541 pam-fi 1.9 real function pfaeta4(ic,angle)
542 mocchiut 1.1 *--------------------------------------------------------------
543     * this function returns
544     *
545     * - the position (in strip units)
546     * corrected according to the ETA4 Position Finding Algorithm.
547     * The function performs an interpolation of FETA3%ETA3
548     *
549     * - if the angle is out of range, the calibration parameters
550     * of the lowest or higher bin are used
551     *
552     *--------------------------------------------------------------
553     include 'commontracker.f'
554     include 'calib.f'
555     include 'level1.f'
556    
557     real cog4,angle
558     integer iview,lad
559    
560 pam-fi 1.6
561 pam-fi 1.9 iview = VIEW(ic)
562     lad = nld(MAXS(ic),VIEW(ic))
563     cog4=cog(4,ic)
564 pam-fi 1.4 pfaeta4=cog4
565 mocchiut 1.1
566     * find angular bin
567     * (in futuro possiamo pensare di interpolare anche sull'angolo)
568     do iang=1,nangbin
569     c print*,'~~~~~~~~~~~~ ',iang,angL(iang),angR(iang),angle
570     if(angL(iang).lt.angle.and.angR(iang).ge.angle)then
571     iangle=iang
572     goto 98
573     endif
574     enddo
575 pam-fi 1.18 if(DEBUG.EQ.1)
576 pam-fi 1.4 $ print*,'pfaeta4 *** warning *** angle out of range: ',angle
577 mocchiut 1.1 if(angle.lt.angL(1))iang=1
578     if(angle.gt.angR(nangbin))iang=nangbin
579     98 continue !jump here if ok
580    
581    
582     c$$$* find extremes of interpolation
583     c$$$ iflag=0
584     c$$$* --------------------------------
585     c$$$ if(cog3.lt.eta3(1,iang).or.cog3.gt.eta3(netaval,iang))then
586     c$$$* ----------------------------------------------
587     c$$$* non salto piu`, ma scalo di 1 o -1
588     c$$$* nel caso si tratti di un cluster
589     c$$$* in cui la strip con il segnale massimo non coincide
590     c$$$* con la strip con il rapposto s/n massimo!!!
591     c$$$* ----------------------------------------------
592     c$$$ if(cog2.lt.eta2(1,iang))then !temp
593     c$$$ cog2=cog2+1. !temp
594     c$$$ iflag=1 !temp
595     c$$$ else !temp
596     c$$$ cog2=cog2-1. !temp
597     c$$$ iflag=-1 !temp
598     c$$$ endif !temp
599     c$$$c print*,'shifted >>> ',cog2
600     c$$$ endif
601    
602    
603     iadd=0
604     10 continue
605     if(cog4.lt.eta4(1,iang))then
606     cog4 = cog4 + 1
607     iadd = iadd + 1
608     goto 10
609     endif
610     20 continue
611     if(cog4.gt.eta4(netaval,iang))then
612     cog4 = cog4 - 1
613     iadd = iadd - 1
614     goto 20
615     endif
616    
617     * --------------------------------
618     c print*,'*****',i,view,lad,iang,'------> cog2 ',cog2
619     do i=2,netaval
620     if(eta4(i,iang).gt.cog4)then
621    
622     x1 = eta4(i-1,iang)
623     x2 = eta4(i,iang)
624     y1 = feta4(i-1,iview,lad,iang)
625     y2 = feta4(i,iview,lad,iang)
626    
627     c print*,'*****',i,view,lad,iang
628     c print*,'-----',x1,x2,y1,y2
629     goto 99
630     endif
631     enddo
632     99 continue
633    
634    
635     AA=(y2-y1)/(x2-x1)
636     BB=y1-AA*x1
637    
638 pam-fi 1.4 pfaeta4 = AA*cog4+BB
639     pfaeta4 = pfaeta4 - iadd
640 mocchiut 1.1
641     c$$$ if(iflag.eq.1)then
642 pam-fi 1.4 c$$$ pfaeta2=pfaeta2-1. !temp
643 mocchiut 1.1 c$$$ cog2=cog2-1. !temp
644     c$$$ endif
645     c$$$ if(iflag.eq.-1)then
646 pam-fi 1.4 c$$$ pfaeta2=pfaeta2+1. !temp
647 mocchiut 1.1 c$$$ cog2=cog2+1. !temp
648     c$$$ endif
649    
650 pam-fi 1.18 if(DEBUG.EQ.1)print*,'ETA4 (ic ',ic,' ang',angle,')'
651 pam-fi 1.4 $ ,cog4-iadd,' -->',pfaeta4
652 mocchiut 1.1
653     100 return
654     end
655    
656    
657    
658     *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
659 pam-fi 1.14 c$$$ real function cog0(ncog,ic)
660     c$$$*-------------------------------------------------
661     c$$$* this function returns
662     c$$$*
663     c$$$* - the Center-Of-Gravity of the cluster IC
664     c$$$* evaluated using NCOG strips,
665     c$$$* calculated relative to MAXS(IC)
666     c$$$*
667     c$$$* - zero in case that not enough strips
668     c$$$* have a positive signal
669     c$$$*
670     c$$$* NOTE:
671     c$$$* This is the old definition, used by Straulino.
672     c$$$* The new routine, according to Landi,
673     c$$$* is COG(NCOG,IC)
674     c$$$*-------------------------------------------------
675     c$$$
676     c$$$
677     c$$$ include 'commontracker.f'
678     c$$$ include 'level1.f'
679     c$$$
680     c$$$* --> signal of the central strip
681     c$$$ sc = CLSIGNAL(INDMAX(ic)) !center
682     c$$$
683     c$$$* signal of adjacent strips
684     c$$$* --> left
685     c$$$ sl1 = 0 !left 1
686     c$$$ if(
687     c$$$ $ (INDMAX(ic)-1).ge.INDSTART(ic)
688     c$$$ $ )
689     c$$$ $ sl1 = max(0.,CLSIGNAL(INDMAX(ic)-1))
690     c$$$
691     c$$$ sl2 = 0 !left 2
692     c$$$ if(
693     c$$$ $ (INDMAX(ic)-2).ge.INDSTART(ic)
694     c$$$ $ )
695     c$$$ $ sl2 = max(0.,CLSIGNAL(INDMAX(ic)-2))
696     c$$$
697     c$$$* --> right
698     c$$$ sr1 = 0 !right 1
699     c$$$ if(
700     c$$$ $ (ic.ne.NCLSTR1.and.(INDMAX(ic)+1).lt.INDSTART(ic+1))
701     c$$$ $ .or.
702     c$$$ $ (ic.eq.NCLSTR1.and.(INDMAX(ic)+1).le.TOTCLLENGTH)
703     c$$$ $ )
704     c$$$ $ sr1 = max(0.,CLSIGNAL(INDMAX(ic)+1))
705     c$$$
706     c$$$ sr2 = 0 !right 2
707     c$$$ if(
708     c$$$ $ (ic.ne.NCLSTR1.and.(INDMAX(ic)+2).lt.INDSTART(ic+1))
709     c$$$ $ .or.
710     c$$$ $ (ic.eq.NCLSTR1.and.(INDMAX(ic)+2).le.TOTCLLENGTH)
711     c$$$ $ )
712     c$$$ $ sr2 = max(0.,CLSIGNAL(INDMAX(ic)+2))
713     c$$$
714     c$$$************************************************************
715     c$$$* COG computation
716     c$$$************************************************************
717     c$$$
718     c$$$c print*,sl2,sl1,sc,sr1,sr2
719     c$$$
720     c$$$ COG = 0.
721     c$$$
722     c$$$ if(sl1.gt.sr1.and.sl1.gt.0.)then
723     c$$$
724     c$$$ if(ncog.eq.2.and.sl1.ne.0)then
725     c$$$ COG = -sl1/(sl1+sc)
726     c$$$ elseif(ncog.eq.3.and.sl1.ne.0.and.sr1.ne.0)then
727     c$$$ COG = (sr1-sl1)/(sl1+sc+sr1)
728     c$$$ elseif(ncog.eq.4.and.sl1.ne.0.and.sr1.ne.0.and.sl2.ne.0)then
729     c$$$ COG = (sr1-sl1-2*sl2)/(sl2+sl1+sc+sr1)
730     c$$$ else
731     c$$$ COG = 0.
732     c$$$ endif
733     c$$$
734     c$$$ elseif(sl1.le.sr1.and.sr1.gt.0.)then
735     c$$$
736     c$$$ if(ncog.eq.2.and.sr1.ne.0)then
737     c$$$ COG = sr1/(sc+sr1)
738     c$$$ elseif(ncog.eq.3.and.sr1.ne.0.and.sl1.ne.0)then
739     c$$$ COG = (sr1-sl1)/(sl1+sc+sr1)
740     c$$$ elseif(ncog.eq.4.and.sr1.ne.0.and.sl1.ne.0.and.sr2.ne.0)then
741     c$$$ COG = (2*sr2+sr1-sl1)/(sl2+sl1+sc+sr1)
742     c$$$ else
743     c$$$ COG = 0.
744     c$$$ endif
745     c$$$
746     c$$$ endif
747     c$$$
748     c$$$ COG0 = COG
749     c$$$
750     c$$$c print *,ncog,ic,cog,'/////////////'
751     c$$$
752     c$$$ return
753     c$$$ end
754 mocchiut 1.1
755     *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
756     real function cog(ncog,ic)
757     *-------------------------------------------------
758     * this function returns
759     *
760     * - if NCOG=0, the Center-Of-Gravity of the
761     * cluster IC, relative to MAXS(IC), according to
762     * the cluster multiplicity
763     *
764     * - if NCOG>0, the Center-Of-Gravity of the cluster IC
765     * evaluated using NCOG strips, even if they have a
766     * negative signal (according to Landi)
767     *
768     *-------------------------------------------------
769    
770    
771     include 'commontracker.f'
772     include 'calib.f'
773     include 'level1.f'
774    
775    
776    
777     if (ncog.gt.0) then
778     * ===========================
779     * ETA2 ETA3 ETA4 computation
780     * ===========================
781    
782     * --> signal of the central strip
783     sc = CLSIGNAL(INDMAX(ic)) !center
784     * signal of adjacent strips
785 pam-fi 1.14 sl1 = -9999. !left 1
786 mocchiut 1.1 if(
787     $ (INDMAX(ic)-1).ge.INDSTART(ic)
788     $ )
789     $ sl1 = CLSIGNAL(INDMAX(ic)-1)
790    
791 pam-fi 1.14 sl2 = -9999. !left 2
792 mocchiut 1.1 if(
793     $ (INDMAX(ic)-2).ge.INDSTART(ic)
794     $ )
795     $ sl2 = CLSIGNAL(INDMAX(ic)-2)
796    
797 pam-fi 1.14 sr1 = -9999. !right 1
798 mocchiut 1.1 if(
799     $ (ic.ne.NCLSTR1.and.(INDMAX(ic)+1).lt.INDSTART(ic+1))
800     $ .or.
801     $ (ic.eq.NCLSTR1.and.(INDMAX(ic)+1).le.TOTCLLENGTH)
802     $ )
803     $ sr1 = CLSIGNAL(INDMAX(ic)+1)
804    
805 pam-fi 1.14 sr2 = -9999. !right 2
806 mocchiut 1.1 if(
807     $ (ic.ne.NCLSTR1.and.(INDMAX(ic)+2).lt.INDSTART(ic+1))
808     $ .or.
809     $ (ic.eq.NCLSTR1.and.(INDMAX(ic)+2).le.TOTCLLENGTH)
810     $ )
811     $ sr2 = CLSIGNAL(INDMAX(ic)+2)
812    
813     COG = 0.
814    
815 pam-fi 1.6 c print*,'## ',sl2,sl1,sc,sr1,sr2
816    
817 pam-fi 1.14 c ==============================================================
818 pam-fi 1.4 if(ncog.eq.1)then
819     COG = 0.
820 pam-fi 1.14 if(sr1.gt.sc)cog=1. !NEW
821     if(sl1.gt.sc.and.sl1.gt.sr1)cog=-1. !NEW
822     c ==============================================================
823 pam-fi 1.4 elseif(ncog.eq.2)then
824 mocchiut 1.1 if(sl1.gt.sr1)then
825 pam-fi 1.6 if((sl1+sc).ne.0)COG = -sl1/(sl1+sc)
826 pam-fi 1.14 elseif(sl1.lt.sr1)then
827     if((sc+sr1).ne.0)COG = sr1/(sc+sr1)
828     elseif( sl1.eq.sr1.and.sl1.ne.-9999.)then !NEW
829     if( clsigma(indmax(ic)-1).lt.clsigma(indmax(ic)+1)
830     $ .and.(sl1+sc).ne.0 )cog = -sl1/(sl1+sc) !NEW
831     if( clsigma(indmax(ic)-1).gt.clsigma(indmax(ic)+1)
832     $ .and.(sc+sr1).ne.0 )cog = sr1/(sc+sr1) !NEW
833     endif
834 pam-fi 1.15 c if(cog==0)print*,'Strange cluster (2) - @maxs ',MAXS(ic)
835     c $ ,' : ',sl2,sl1,sc,sr1,sr2
836 pam-fi 1.14 c ==============================================================
837 mocchiut 1.1 elseif(ncog.eq.3)then
838 pam-fi 1.14 if( (sl1+sc+sr1).ne.0 )COG = (sr1-sl1)/(sl1+sc+sr1)
839 pam-fi 1.15 c if(cog==0)print*,'Strange cluster (3) - @maxs ',MAXS(ic)
840     c $ ,' : ',sl2,sl1,sc,sr1,sr2
841 pam-fi 1.14 c ==============================================================
842 mocchiut 1.1 elseif(ncog.eq.4)then
843     if(sl2.gt.sr2)then
844 pam-fi 1.6 if((sl2+sl1+sc+sr1).ne.0)
845     $ COG = (sr1-sl1-2*sl2)/(sl2+sl1+sc+sr1)
846 pam-fi 1.14 elseif(sl2.lt.sr2)then
847     if((sr2+sl1+sc+sr1).ne.0)
848 pam-fi 1.12 $ COG = (2*sr2+sr1-sl1)/(sr2+sl1+sc+sr1)
849 pam-fi 1.14 elseif(sl2.eq.sr2.and.sl2.ne.-9999.)then !NEW
850     if( clsigma(indmax(ic)-2).lt.clsigma(indmax(ic)+2)
851     $ .and.(sl2+sl1+sc+sr1).ne.0 )
852     $ cog = (sr1-sl1-2*sl2)/(sl2+sl1+sc+sr1) !NEW
853     if( clsigma(indmax(ic)-2).gt.clsigma(indmax(ic)+2)
854     $ .and.(sr2+sl1+sc+sr1).ne.0 )
855     $ cog = (2*sr2+sr1-sl1)/(sr2+sl1+sc+sr1) !NEW
856 mocchiut 1.1 endif
857     else
858     print*,'function COG(NCOG,IC) ==> WARNING!! NCOG=',NCOG
859 pam-fi 1.7 $ ,' not implemented'
860 mocchiut 1.1 COG = 0.
861     endif
862    
863     c print*,'NCOG ',ncog,ic,' @@@ ',sl1,sc,sr1,' @@@ ',cog
864    
865     elseif(ncog.eq.0)then
866     * =========================
867     * COG computation
868     * =========================
869    
870     iv=VIEW(ic)
871     if(mod(iv,2).eq.1)incut=incuty
872     if(mod(iv,2).eq.0)incut=incutx
873 pam-fi 1.3 istart = INDSTART(IC)
874     istop = TOTCLLENGTH
875 mocchiut 1.1 if(ic.lt.NCLSTR1)istop=INDSTART(IC+1)-1
876 pam-fi 1.3 COG = 0
877 pam-fi 1.9 SGN = 0.
878 pam-fi 1.3 mu = 0
879 pam-fi 1.9 c print*,'-------'
880     do i = INDMAX(IC),istart,-1
881     ipos = i-INDMAX(ic)
882     cut = incut*CLSIGMA(i)
883     if(CLSIGNAL(i).ge.cut)then
884     COG = COG + ipos*CLSIGNAL(i)
885     SGN = SGN + CLSIGNAL(i)
886     mu = mu + 1
887 pam-fi 1.12 c print*,ipos,CLSIGNAL(i)
888 pam-fi 1.9 else
889     goto 10
890     endif
891     enddo
892     10 continue
893     do i = INDMAX(IC)+1,istop
894 pam-fi 1.3 ipos = i-INDMAX(ic)
895 pam-fi 1.4 cut = incut*CLSIGMA(i)
896 mocchiut 1.1 if(CLSIGNAL(i).ge.cut)then
897     COG = COG + ipos*CLSIGNAL(i)
898 pam-fi 1.9 SGN = SGN + CLSIGNAL(i)
899 mocchiut 1.1 mu = mu + 1
900 pam-fi 1.12 c print*,ipos,CLSIGNAL(i)
901 pam-fi 1.9 else
902     goto 20
903 mocchiut 1.1 endif
904     enddo
905 pam-fi 1.9 20 continue
906     if(SGN.le.0)then
907 pam-fi 1.12 print*,'cog(0,ic) --> ic, dedx ',ic,SGN
908 pam-fi 1.3 print*,(CLSIGNAL(i)/CLSIGMA(i),i=istart,istop)
909     print*,(CLSIGNAL(i),i=istart,istop)
910 pam-fi 1.9 c print*,'cog(0,ic) --> NOT EVALUATED '
911 pam-fi 1.3 else
912 pam-fi 1.9 COG=COG/SGN
913 pam-fi 1.3 endif
914 pam-fi 1.9 c print*,'-------'
915 mocchiut 1.1
916     else
917    
918     COG=0
919     print*,'function COG(NCOG,IC) ==> WARNING!! NCOG=',NCOG
920     print*,' (NCOG must be >= 0)'
921    
922    
923     endif
924    
925 pam-fi 1.6 c print *,'## cog ',ncog,ic,cog,'/////////////'
926 mocchiut 1.1
927     return
928     end
929    
930     *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
931 pam-fi 1.9
932 mocchiut 1.1 real function fbad_cog(ncog,ic)
933     *-------------------------------------------------------
934     * this function returns a factor that takes into
935     * account deterioration of the spatial resolution
936     * in the case BAD strips are included in the cluster.
937     * This factor should multiply the nominal spatial
938     * resolution.
939     *
940     *-------------------------------------------------------
941    
942     include 'commontracker.f'
943     include 'level1.f'
944     include 'calib.f'
945    
946     if(mod(int(VIEW(ic)),2).eq.1)then !Y-view
947 pam-fi 1.9 si = 8.4 !average good-strip noise
948     f = 4. !average bad-strip noise: f*si
949 mocchiut 1.1 incut=incuty
950     else !X-view
951 pam-fi 1.9 si = 3.9 !average good-strip noise
952     f = 6. !average bad-strip noise: f*si
953 mocchiut 1.1 incut=incutx
954     endif
955    
956     fbad_cog = 1.
957    
958     if (ncog.gt.0) then
959    
960     * --> signal of the central strip
961     sc = CLSIGNAL(INDMAX(ic)) !center
962     fsc = 1
963 pam-fi 1.9 c if( CLBAD(INDMAX(ic)).eq.0 )fsc=f
964     fsc = clsigma(INDMAX(ic))/si
965 mocchiut 1.1 * --> signal of adjacent strips
966     sl1 = 0 !left 1
967     fsl1 = 1 !left 1
968     if(
969     $ (INDMAX(ic)-1).ge.INDSTART(ic)
970     $ )then
971     sl1 = CLSIGNAL(INDMAX(ic)-1)
972 pam-fi 1.9 c if( CLBAD(INDMAX(ic)-1).eq.0)fsl1=f
973     fsl1 = clsigma(INDMAX(ic)-1)/si
974 mocchiut 1.1 endif
975    
976     sl2 = 0 !left 2
977     fsl2 = 1 !left 2
978     if(
979     $ (INDMAX(ic)-2).ge.INDSTART(ic)
980     $ )then
981     sl2 = CLSIGNAL(INDMAX(ic)-2)
982 pam-fi 1.9 c if(CLBAD(INDMAX(ic)-2).eq.0)fsl2=f
983     fsl2 = clsigma(INDMAX(ic)-2)/si
984 mocchiut 1.1 endif
985     sr1 = 0 !right 1
986     fsr1 = 1 !right 1
987     if(
988     $ (ic.ne.NCLSTR1.and.(INDMAX(ic)+1).lt.INDSTART(ic+1))
989     $ .or.
990     $ (ic.eq.NCLSTR1.and.(INDMAX(ic)+1).le.TOTCLLENGTH)
991     $ )then
992     sr1 = CLSIGNAL(INDMAX(ic)+1)
993 pam-fi 1.9 c if(CLBAD(INDMAX(ic)+1).eq.0)fsr1=f
994     fsr1 = clsigma(INDMAX(ic)+1)/si
995 mocchiut 1.1 endif
996     sr2 = 0 !right 2
997     fsr2 = 1 !right 2
998     if(
999     $ (ic.ne.NCLSTR1.and.(INDMAX(ic)+2).lt.INDSTART(ic+1))
1000     $ .or.
1001     $ (ic.eq.NCLSTR1.and.(INDMAX(ic)+2).le.TOTCLLENGTH)
1002     $ )then
1003     sr2 = CLSIGNAL(INDMAX(ic)+2)
1004 pam-fi 1.9 c if(CLBAD(INDMAX(ic)+2).eq.0)fsr2=f
1005     fsr2 = clsigma(INDMAX(ic)+2)/si
1006 mocchiut 1.1 endif
1007    
1008    
1009    
1010     ************************************************************
1011 pam-fi 1.9 * COG2-3-4 computation
1012 mocchiut 1.1 ************************************************************
1013    
1014     c print*,sl2,sl1,sc,sr1,sr2
1015    
1016 pam-fi 1.9 vCOG = cog(ncog,ic)!0.
1017 mocchiut 1.1
1018     if(ncog.eq.2)then
1019     if(sl1.gt.sr1)then
1020 pam-fi 1.9 c COG = -sl1/(sl1+sc)
1021     fbad_cog = (fsl1*(-1-vCOG)**2+fsc*(-vCOG)**2)
1022     fbad_cog = fbad_cog / ((-1-vCOG)**2+(-vCOG)**2)
1023 mocchiut 1.1 elseif(sl1.le.sr1)then
1024 pam-fi 1.9 c COG = sr1/(sc+sr1)
1025     fbad_cog = (fsc*(-vCOG)**2+fsr1*(1-vCOG)**2)
1026     fbad_cog = fbad_cog / ((-vCOG)**2+(1-vCOG)**2)
1027 mocchiut 1.1 endif
1028     elseif(ncog.eq.3)then
1029 pam-fi 1.9 c COG = (sr1-sl1)/(sl1+sc+sr1)
1030 mocchiut 1.1 fbad_cog =
1031 pam-fi 1.9 $ (fsl1*(-1-vCOG)**2+fsc*(-vCOG)**2+fsr1*(1-vCOG)**2)
1032 mocchiut 1.1 fbad_cog =
1033 pam-fi 1.9 $ fbad_cog / ((-1-vCOG)**2+(-vCOG)**2+(1-vCOG)**2)
1034 mocchiut 1.1 elseif(ncog.eq.4)then
1035     if(sl2.gt.sr2)then
1036 pam-fi 1.9 c COG = (sr1-sl1-2*sl2)/(sl2+sl1+sc+sr1)
1037 mocchiut 1.1 fbad_cog =
1038 pam-fi 1.9 $ (fsl2*(-2-vCOG)**2+fsl1*(-1-vCOG)**2
1039     $ +fsc*(-vCOG)**2+fsr1*(1-vCOG)**2)
1040 mocchiut 1.1 fbad_cog =
1041 pam-fi 1.9 $ fbad_cog / ((-2-vCOG)**2+(-1-vCOG)**2
1042     $ +(-vCOG)**2+(1-vCOG)**2)
1043 mocchiut 1.1 elseif(sl2.le.sr2)then
1044 pam-fi 1.9 c COG = (2*sr2+sr1-sl1)/(sl2+sl1+sc+sr1)
1045 mocchiut 1.1 fbad_cog =
1046 pam-fi 1.9 $ (fsl1*(-1-vCOG)**2
1047     $ +fsc*(-vCOG)**2+fsr1*(1-vCOG)**2+fsr2*(2-vCOG)**2)
1048 mocchiut 1.1 fbad_cog =
1049 pam-fi 1.9 $ fbad_cog / ((-1-vCOG)**2
1050     $ +(-vCOG)**2+(1-vCOG)**2+(2-vCOG)**2)
1051 mocchiut 1.1 endif
1052     else
1053     print*,'function FBAD_COG(NCOG,IC) ==> WARNING!! NCOG=',NCOG
1054     print*,' (NCOG must be <= 4)'
1055 pam-fi 1.9 c COG = 0.
1056 mocchiut 1.1 endif
1057    
1058     elseif(ncog.eq.0)then
1059 pam-fi 1.9 * =========================
1060     * COG computation
1061     * =========================
1062    
1063     vCOG = cog(0,ic)
1064 mocchiut 1.1
1065 pam-fi 1.9 iv = VIEW(ic)
1066     istart = INDSTART(IC)
1067     istop = TOTCLLENGTH
1068     if(ic.lt.NCLSTR1)istop = INDSTART(IC+1)-1
1069     SGN = 0.
1070     SNU = 0.
1071     SDE = 0.
1072     c$$$ do i=INDMAX(IC),istart,-1
1073     c$$$ ipos = i-INDMAX(ic)
1074     c$$$ cut = incut*CLSIGMA(i)
1075     c$$$ if(CLSIGNAL(i).gt.cut)then
1076     c$$$ COG = COG + ipos*CLSIGNAL(i)
1077     c$$$ SGN = SGN + CLSIGNAL(i)
1078     c$$$ else
1079     c$$$ goto 10
1080     c$$$ endif
1081     c$$$ enddo
1082     c$$$ 10 continue
1083     c$$$ do i=INDMAX(IC)+1,istop
1084     c$$$ ipos = i-INDMAX(ic)
1085     c$$$ cut = incut*CLSIGMA(i)
1086     c$$$ if(CLSIGNAL(i).gt.cut)then
1087     c$$$ COG = COG + ipos*CLSIGNAL(i)
1088     c$$$ SGN = SGN + CLSIGNAL(i)
1089     c$$$ else
1090     c$$$ goto 20
1091     c$$$ endif
1092     c$$$ enddo
1093     c$$$ 20 continue
1094     c$$$ if(SGN.le.0)then
1095     c$$$ print*,'fbad_cog(0,ic) --> ic, dedx ',ic,SGN
1096     c$$$ print*,(CLSIGNAL(i)/CLSIGMA(i),i=istart,istop)
1097     c$$$ print*,(CLSIGNAL(i),i=istart,istop)
1098     c$$$ print*,'fbad_cog(0,ic) --> NOT EVALUATED '
1099     c$$$ else
1100     c$$$ COG=COG/SGN
1101     c$$$ endif
1102    
1103     do i=INDMAX(IC),istart,-1
1104     ipos = i-INDMAX(ic)
1105     cut = incut*CLSIGMA(i)
1106 mocchiut 1.1 if(CLSIGNAL(i).gt.cut)then
1107 pam-fi 1.9 fs = clsigma(i)/si
1108     SNU = SNU + fs*(ipos-vCOG)**2
1109     SDE = SDE + (ipos-vCOG)**2
1110     else
1111     goto 10
1112     endif
1113 mocchiut 1.1 enddo
1114 pam-fi 1.9 10 continue
1115     do i=INDMAX(IC)+1,istop
1116     ipos = i-INDMAX(ic)
1117     cut = incut*CLSIGMA(i)
1118 mocchiut 1.1 if(CLSIGNAL(i).gt.cut)then
1119 pam-fi 1.9 fs = clsigma(i)/si
1120     SNU = SNU + fs*(ipos-vCOG)**2
1121     SDE = SDE + (ipos-vCOG)**2
1122     else
1123     goto 20
1124 mocchiut 1.1 endif
1125     enddo
1126 pam-fi 1.9 20 continue
1127     if(SDE.ne.0)then
1128     FBAD_COG=SNU/SDE
1129     else
1130    
1131     endif
1132 mocchiut 1.1
1133     else
1134    
1135     FBAD_COG=0
1136     print*,'function FBAD_COG(NCOG,IC) ==> WARNING!! NCOG=',NCOG
1137     print*,' (NCOG must be >= 0)'
1138    
1139    
1140     endif
1141    
1142    
1143     fbad_cog = sqrt(fbad_cog)
1144    
1145     return
1146     end
1147    
1148    
1149     *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
1150     real function fbad_cog0(ncog,ic)
1151     *-------------------------------------------------------
1152     * this function returns a factor that takes into
1153     * account deterioration of the spatial resolution
1154     * in the case BAD strips are included in the cluster.
1155     * This factor should multiply the nominal spatial
1156     * resolution.
1157     *
1158     * NB!!!
1159     * (this is the old version. It consider only the two
1160     * strips with the greatest signal. The new one is
1161     * fbad_cog(ncog,ic) )
1162     *
1163     *-------------------------------------------------------
1164    
1165     include 'commontracker.f'
1166     include 'level1.f'
1167     include 'calib.f'
1168    
1169     * --> signal of the central strip
1170     sc = CLSIGNAL(INDMAX(ic)) !center
1171    
1172     * signal of adjacent strips
1173     * --> left
1174     sl1 = 0 !left 1
1175     if(
1176     $ (INDMAX(ic)-1).ge.INDSTART(ic)
1177     $ )
1178     $ sl1 = max(0.,CLSIGNAL(INDMAX(ic)-1))
1179    
1180     sl2 = 0 !left 2
1181     if(
1182     $ (INDMAX(ic)-2).ge.INDSTART(ic)
1183     $ )
1184     $ sl2 = max(0.,CLSIGNAL(INDMAX(ic)-2))
1185    
1186     * --> right
1187     sr1 = 0 !right 1
1188     if(
1189     $ (ic.ne.NCLSTR1.and.(INDMAX(ic)+1).lt.INDSTART(ic+1))
1190     $ .or.
1191     $ (ic.eq.NCLSTR1.and.(INDMAX(ic)+1).le.TOTCLLENGTH)
1192     $ )
1193     $ sr1 = max(0.,CLSIGNAL(INDMAX(ic)+1))
1194    
1195     sr2 = 0 !right 2
1196     if(
1197     $ (ic.ne.NCLSTR1.and.(INDMAX(ic)+2).lt.INDSTART(ic+1))
1198     $ .or.
1199     $ (ic.eq.NCLSTR1.and.(INDMAX(ic)+2).le.TOTCLLENGTH)
1200     $ )
1201     $ sr2 = max(0.,CLSIGNAL(INDMAX(ic)+2))
1202    
1203    
1204     if(mod(int(VIEW(ic)),2).eq.1)then !Y-view
1205     f = 4.
1206     si = 8.4
1207     else !X-view
1208     f = 6.
1209     si = 3.9
1210     endif
1211    
1212     fbad_cog = 1.
1213     f0 = 1
1214     f1 = 1
1215     f2 = 1
1216     f3 = 1
1217     if(sl1.gt.sr1.and.sl1.gt.0.)then
1218    
1219     if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)) ).eq.0)f0=f
1220     if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)-1)).eq.0)f1=f
1221     c if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)+1)).eq.0)f3=f
1222    
1223     if(ncog.eq.2.and.sl1.ne.0)then
1224     fbad_cog = (f1**2*sc**2/sl1**2+f0**2)/(sc**2/sl1**2+1.)
1225     elseif(ncog.eq.3.and.sl1.ne.0.and.sr1.ne.0)then
1226     fbad_cog = 1.
1227     elseif(ncog.eq.4.and.sl1.ne.0.and.sr1.ne.0.and.sl2.ne.0)then
1228     fbad_cog = 1.
1229     else
1230     fbad_cog = 1.
1231     endif
1232    
1233     elseif(sl1.le.sr1.and.sr1.gt.0.)then
1234    
1235    
1236     if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)) ).eq.0)f0=f
1237     if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)+1)).eq.0)f1=f
1238     c if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)-1)).eq.0)f3=f
1239    
1240     if(ncog.eq.2.and.sr1.ne.0)then
1241     fbad_cog = (f1**2*sc**2/sr1**2+f0**2)/(sc**2/sr1**2+1.)
1242     elseif(ncog.eq.3.and.sr1.ne.0.and.sl1.ne.0)then
1243     fbad_cog = 1.
1244     elseif(ncog.eq.4.and.sr1.ne.0.and.sl1.ne.0.and.sr2.ne.0)then
1245     fbad_cog = 1.
1246     else
1247     fbad_cog = 1.
1248     endif
1249    
1250     endif
1251    
1252     fbad_cog0 = sqrt(fbad_cog)
1253    
1254     return
1255     end
1256    
1257    
1258    
1259    
1260     *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
1261    
1262 pam-fi 1.13 FUNCTION risxeta2(x)
1263 mocchiut 1.1
1264     DOUBLE PRECISION V( 1)
1265     INTEGER NPAR, NDIM, IMQFUN, I, J
1266     DOUBLE PRECISION HQDJ, VV, VCONST
1267     DOUBLE PRECISION SIGVMI( 1), SIGVT( 1)
1268     DOUBLE PRECISION SIGV( 18, 1)
1269     DOUBLE PRECISION SIGDEL( 18)
1270     DOUBLE PRECISION SIGA( 18)
1271     DATA NPAR, NDIM, IMQFUN / 18, 1, 1/
1272     DATA VCONST / 0.000000000000 /
1273     DATA SIGVMI / -20.50000000000 /
1274     DATA SIGVT / 41.00000000000 /
1275     DATA SIGV / 0.6097560748458E-01
1276     +, 0.1097560971975
1277     +, 0.1341463327408
1278     +, 0.1829268187284
1279     +, 0.2317073047161
1280     +, 0.4268292486668
1281     +, 0.4756097495556
1282     +, 0.4999999701977
1283     +, 0.5243902206421
1284     +, 0.5731707215309
1285     +, 0.7682926654816
1286     +, 0.8170731663704
1287     +, 0.8658536076546
1288     +, 0.8902438879013
1289     +, 0.9390243291855
1290     +, 0.000000000000
1291     +, 1.000000000000
1292     +, 0.3658536374569
1293     +/
1294     DATA SIGDEL / 0.4878048598766E-01
1295     +, 0.4878048598766E-01
1296     +, 0.4878048598766E-01
1297     +, 0.4878048598766E-01
1298     +, 0.4878048598766E-01
1299     +, 0.4878048598766E-01
1300     +, 0.4878048598766E-01
1301     +, 0.4878048598766E-01
1302     +, 0.4878048598766E-01
1303     +, 0.4878048598766E-01
1304     +, 0.4878048598766E-01
1305     +, 0.4878048598766E-01
1306     +, 0.4878048598766E-01
1307     +, 0.4878048598766E-01
1308     +, 0.4878048598766E-01
1309     +, 0.1999999994950E-05
1310     +, 0.1999999994950E-05
1311     +, 0.9756097197533E-01
1312     +/
1313     DATA SIGA / 51.65899502118
1314     +, -150.4733247841
1315     +, 143.0468613786
1316     +, -16.56096738997
1317     +, 5.149319798083
1318     +, 21.57149712673
1319     +, -39.46652322782
1320     +, 47.13181632948
1321     +, -32.93197883680
1322     +, 16.38645317092
1323     +, 1.453688482992
1324     +, -10.00547244421
1325     +, 131.3517670587
1326     +, -140.6351538257
1327     +, 49.05515749582
1328     +, -23.00028974788
1329     +, -22.58470403729
1330     +, -3.824682486418
1331     +/
1332    
1333     V(1)= abs(x)
1334 pam-fi 1.9 if(V(1).gt.20.)V(1)=20.
1335 mocchiut 1.1
1336     HQUADF = 0.
1337     DO 20 J = 1, NPAR
1338     HQDJ = 0.
1339     DO 10 I = 1, NDIM
1340     VV = (V (I) - SIGVMI (I)) / SIGVT (I)
1341     HQDJ = HQDJ + (VV - SIGV (J, I)) ** 2
1342     10 CONTINUE
1343     HQDJ = HQDJ + SIGDEL (J) ** 2
1344     HQDJ = SQRT (HQDJ)
1345     HQUADF = HQUADF + SIGA (J) * HQDJ
1346     20 CONTINUE
1347     IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)
1348    
1349 pam-fi 1.13 risxeta2=HQUADF* 1e-4
1350 mocchiut 1.1
1351     END
1352    
1353     *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
1354 pam-fi 1.13 FUNCTION risxeta3(x)
1355 mocchiut 1.1 DOUBLE PRECISION V( 1)
1356     INTEGER NPAR, NDIM, IMQFUN, I, J
1357     DOUBLE PRECISION HQDJ, VV, VCONST
1358     DOUBLE PRECISION SIGVMI( 1), SIGVT( 1)
1359     DOUBLE PRECISION SIGV( 18, 1)
1360     DOUBLE PRECISION SIGDEL( 18)
1361     DOUBLE PRECISION SIGA( 18)
1362     DATA NPAR, NDIM, IMQFUN / 18, 1, 1/
1363     DATA VCONST / 0.000000000000 /
1364     DATA SIGVMI / -20.50000000000 /
1365     DATA SIGVT / 41.00000000000 /
1366     DATA SIGV / 0.6097560748458E-01
1367     +, 0.1097560971975
1368     +, 0.1341463327408
1369     +, 0.1829268187284
1370     +, 0.2317073047161
1371     +, 0.4756097495556
1372     +, 0.4999999701977
1373     +, 0.5243902206421
1374     +, 0.7682926654816
1375     +, 0.8170731663704
1376     +, 0.8658536076546
1377     +, 0.8902438879013
1378     +, 0.9390243291855
1379     +, 0.000000000000
1380     +, 1.000000000000
1381     +, 0.3658536374569
1382     +, 0.4146341383457
1383     +, 0.6097560524940
1384     +/
1385     DATA SIGDEL / 0.4878048598766E-01
1386     +, 0.4878048598766E-01
1387     +, 0.4878048598766E-01
1388     +, 0.4878048598766E-01
1389     +, 0.4878048598766E-01
1390     +, 0.4878048598766E-01
1391     +, 0.4878048598766E-01
1392     +, 0.4878048598766E-01
1393     +, 0.4878048598766E-01
1394     +, 0.4878048598766E-01
1395     +, 0.4878048598766E-01
1396     +, 0.4878048598766E-01
1397     +, 0.4878048598766E-01
1398     +, 0.1999999994950E-05
1399     +, 0.1999999994950E-05
1400     +, 0.9756097197533E-01
1401     +, 0.9756097197533E-01
1402     +, 0.9756097197533E-01
1403     +/
1404     DATA SIGA / 55.18284054458
1405     +, -160.3358431242
1406     +, 144.6939185763
1407     +, -20.45200854118
1408     +, 5.223570087108
1409     +,-0.4171476953945
1410     +, -27.67911907462
1411     +, 17.70327157495
1412     +, -1.867165491707
1413     +, -8.884458169181
1414     +, 124.3526608791
1415     +, -143.3309398345
1416     +, 50.80345027122
1417     +, -16.44454904415
1418     +, -15.73785568450
1419     +, -22.71810502561
1420     +, 36.86170101430
1421     +, 2.437918198452
1422     +/
1423    
1424     V(1) = abs(x)
1425 pam-fi 1.9 if(V(1).gt.20.)V(1)=20.
1426    
1427 mocchiut 1.1 HQUADF = 0.
1428     DO 20 J = 1, NPAR
1429     HQDJ = 0.
1430     DO 10 I = 1, NDIM
1431     VV = (V (I) - SIGVMI (I)) / SIGVT (I)
1432     HQDJ = HQDJ + (VV - SIGV (J, I)) ** 2
1433     10 CONTINUE
1434     HQDJ = HQDJ + SIGDEL (J) ** 2
1435     HQDJ = SQRT (HQDJ)
1436     HQUADF = HQUADF + SIGA (J) * HQDJ
1437     20 CONTINUE
1438     IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)
1439    
1440 pam-fi 1.13 risxeta3 = HQUADF* 1e-4
1441 mocchiut 1.1
1442     END
1443     *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
1444 pam-fi 1.13 FUNCTION risxeta4(x)
1445 mocchiut 1.1 DOUBLE PRECISION V( 1)
1446     INTEGER NPAR, NDIM, IMQFUN, I, J
1447     DOUBLE PRECISION HQDJ, VV, VCONST
1448     DOUBLE PRECISION SIGVMI( 1), SIGVT( 1)
1449     DOUBLE PRECISION SIGV( 18, 1)
1450     DOUBLE PRECISION SIGDEL( 18)
1451     DOUBLE PRECISION SIGA( 18)
1452     DATA NPAR, NDIM, IMQFUN / 18, 1, 1/
1453     DATA VCONST / 0.000000000000 /
1454     DATA SIGVMI / -20.50000000000 /
1455     DATA SIGVT / 41.00000000000 /
1456     DATA SIGV / 0.3658536449075E-01
1457     +, 0.6097560748458E-01
1458     +, 0.1097560971975
1459     +, 0.1341463327408
1460     +, 0.4756097495556
1461     +, 0.5243902206421
1462     +, 0.8658536076546
1463     +, 0.8902438879013
1464     +, 0.9390243291855
1465     +, 0.9634146094322
1466     +, 0.000000000000
1467     +, 1.000000000000
1468     +, 0.3658536374569
1469     +, 0.4146341383457
1470     +, 0.6097560524940
1471     +, 0.6585365533829
1472     +, 0.7560975551605
1473     +, 0.2439024299383
1474     +/
1475     DATA SIGDEL / 0.4878048598766E-01
1476     +, 0.4878048598766E-01
1477     +, 0.4878048598766E-01
1478     +, 0.4878048598766E-01
1479     +, 0.4878048598766E-01
1480     +, 0.4878048598766E-01
1481     +, 0.4878048598766E-01
1482     +, 0.4878048598766E-01
1483     +, 0.4878048598766E-01
1484     +, 0.4878048598766E-01
1485     +, 0.1999999994950E-05
1486     +, 0.1999999994950E-05
1487     +, 0.9756097197533E-01
1488     +, 0.9756097197533E-01
1489     +, 0.9756097197533E-01
1490     +, 0.9756097197533E-01
1491     +, 0.9756097197533E-01
1492     +, 0.1951219439507
1493     +/
1494     DATA SIGA / -43.61551887895
1495     +, 57.88466995373
1496     +, -92.04113299504
1497     +, 74.08166649890
1498     +, -9.768686062558
1499     +, -4.304496875334
1500     +, 72.62237333937
1501     +, -91.21920840618
1502     +, 56.75519978630
1503     +, -43.21115751243
1504     +, 12.79984505413
1505     +, 12.10074868595
1506     +, -6.238587250860
1507     +, 23.43447356326
1508     +, 17.98221401495
1509     +, -7.980332610975
1510     +, -3.426733307051
1511     +, -8.683439558751
1512     +/
1513    
1514     V(1)=abs(x)
1515 pam-fi 1.9 if(V(1).gt.20.)V(1)=20.
1516 mocchiut 1.1
1517     HQUADF = 0.
1518     DO 20 J = 1, NPAR
1519     HQDJ = 0.
1520     DO 10 I = 1, NDIM
1521     VV = (V (I) - SIGVMI (I)) / SIGVT (I)
1522     HQDJ = HQDJ + (VV - SIGV (J, I)) ** 2
1523     10 CONTINUE
1524     HQDJ = HQDJ + SIGDEL (J) ** 2
1525     HQDJ = SQRT (HQDJ)
1526     HQUADF = HQUADF + SIGA (J) * HQDJ
1527     20 CONTINUE
1528     IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)
1529    
1530 pam-fi 1.13 risxeta4=HQUADF* 1e-4
1531 mocchiut 1.1
1532     END
1533     *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
1534 pam-fi 1.13 FUNCTION risyeta2(x)
1535 mocchiut 1.1 DOUBLE PRECISION V( 1)
1536     INTEGER NPAR, NDIM, IMQFUN, I, J
1537     DOUBLE PRECISION HQDJ, VV, VCONST
1538     DOUBLE PRECISION SIGVMI( 1), SIGVT( 1)
1539     DOUBLE PRECISION SIGV( 12, 1)
1540     DOUBLE PRECISION SIGDEL( 12)
1541     DOUBLE PRECISION SIGA( 12)
1542     DATA NPAR, NDIM, IMQFUN / 12, 1, 1/
1543     DATA VCONST / 0.000000000000 /
1544     DATA SIGVMI / -20.50000000000 /
1545     DATA SIGVT / 41.00000000000 /
1546     DATA SIGV / 0.1585365831852
1547     +, 0.4024389982224
1548     +, 0.4756097495556
1549     +, 0.5243902206421
1550     +, 0.5975609421730
1551     +, 0.8414633870125
1552     +, 0.000000000000
1553     +, 1.000000000000
1554     +, 0.2682926654816
1555     +, 0.3170731663704
1556     +, 0.7073170542717
1557     +, 0.7560975551605
1558     +/
1559     DATA SIGDEL / 0.4878048598766E-01
1560     +, 0.4878048598766E-01
1561     +, 0.4878048598766E-01
1562     +, 0.4878048598766E-01
1563     +, 0.4878048598766E-01
1564     +, 0.4878048598766E-01
1565     +, 0.1999999994950E-05
1566     +, 0.1999999994950E-05
1567     +, 0.9756097197533E-01
1568     +, 0.9756097197533E-01
1569     +, 0.9756097197533E-01
1570     +, 0.9756097197533E-01
1571     +/
1572     DATA SIGA / 14.57433603529
1573     +, -15.93532436156
1574     +, -13.24628335221
1575     +, -14.31193855410
1576     +, -12.67339684488
1577     +, 18.19876051780
1578     +, -5.270493486725
1579     +, -5.107670990828
1580     +, -9.553262933901
1581     +, 43.34150727448
1582     +, 55.91366786432
1583     +, -29.38037318563
1584     +/
1585    
1586     v(1)= abs(x)
1587 pam-fi 1.9 if(V(1).gt.20.)V(1)=20.
1588 mocchiut 1.1
1589     HQUADF = 0.
1590     DO 20 J = 1, NPAR
1591     HQDJ = 0.
1592     DO 10 I = 1, NDIM
1593     VV = (V (I) - SIGVMI (I)) / SIGVT (I)
1594     HQDJ = HQDJ + (VV - SIGV (J, I)) ** 2
1595     10 CONTINUE
1596     HQDJ = HQDJ + SIGDEL (J) ** 2
1597     HQDJ = SQRT (HQDJ)
1598     HQUADF = HQUADF + SIGA (J) * HQDJ
1599     20 CONTINUE
1600     IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)
1601    
1602 pam-fi 1.13 risyeta2=HQUADF* 1e-4
1603 mocchiut 1.1
1604     END
1605     *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
1606    
1607     FUNCTION risy_cog(x)
1608     DOUBLE PRECISION V( 1)
1609     INTEGER NPAR, NDIM, IMQFUN, I, J
1610     DOUBLE PRECISION HQDJ, VV, VCONST
1611     DOUBLE PRECISION SIGVMI( 1), SIGVT( 1)
1612     DOUBLE PRECISION SIGV( 10, 1)
1613     DOUBLE PRECISION SIGDEL( 10)
1614     DOUBLE PRECISION SIGA( 10)
1615     DATA NPAR, NDIM, IMQFUN / 10, 1, 1/
1616     DATA VCONST / 0.000000000000 /
1617     DATA SIGVMI / -20.50000000000 /
1618     DATA SIGVT / 41.00000000000 /
1619     DATA SIGV / 0.1585365831852
1620     +, 0.8414633870125
1621     +, 0.000000000000
1622     +, 1.000000000000
1623     +, 0.4634146094322
1624     +, 0.5121951103210
1625     +, 0.5609756112099
1626     +, 0.6585365533829
1627     +, 0.7073170542717
1628     +, 0.3414633870125
1629     +/
1630     DATA SIGDEL / 0.4878048598766E-01
1631     +, 0.4878048598766E-01
1632     +, 0.1999999994950E-05
1633     +, 0.1999999994950E-05
1634     +, 0.9756097197533E-01
1635     +, 0.9756097197533E-01
1636     +, 0.9756097197533E-01
1637     +, 0.9756097197533E-01
1638     +, 0.9756097197533E-01
1639     +, 0.1951219439507
1640     +/
1641     DATA SIGA / 23.73833445988
1642     +, 24.10182100013
1643     +, 1.865894323190
1644     +, 1.706006262931
1645     +, -1.075607857202
1646     +, -22.11489493403
1647     +, 1.663100707801
1648     +, 4.089852595440
1649     +, -4.314993873697
1650     +, -2.174479487744
1651     +/
1652    
1653     V(1)=abs(x)
1654 pam-fi 1.9 if(V(1).gt.20.)V(1)=20.
1655 mocchiut 1.1
1656     HQUADF = 0.
1657     DO 20 J = 1, NPAR
1658     HQDJ = 0.
1659     DO 10 I = 1, NDIM
1660     VV = (V (I) - SIGVMI (I)) / SIGVT (I)
1661     HQDJ = HQDJ + (VV - SIGV (J, I)) ** 2
1662     10 CONTINUE
1663     HQDJ = HQDJ + SIGDEL (J) ** 2
1664     HQDJ = SQRT (HQDJ)
1665     HQUADF = HQUADF + SIGA (J) * HQDJ
1666     20 CONTINUE
1667     IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)
1668    
1669     risy_cog=HQUADF* 1e-4
1670    
1671     END
1672     *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
1673     FUNCTION risx_cog(x)
1674     DOUBLE PRECISION V( 1)
1675     INTEGER NPAR, NDIM, IMQFUN, I, J
1676     DOUBLE PRECISION HQDJ, VV, VCONST
1677     DOUBLE PRECISION SIGVMI( 1), SIGVT( 1)
1678     DOUBLE PRECISION SIGV( 15, 1)
1679     DOUBLE PRECISION SIGDEL( 15)
1680     DOUBLE PRECISION SIGA( 15)
1681     DATA NPAR, NDIM, IMQFUN / 15, 1, 1/
1682     DATA VCONST / 0.000000000000 /
1683     DATA SIGVMI / -20.50000000000 /
1684     DATA SIGVT / 41.00000000000 /
1685     DATA SIGV / 0.6097560748458E-01
1686     +, 0.8536584675312E-01
1687     +, 0.1341463327408
1688     +, 0.2317073047161
1689     +, 0.2804878056049
1690     +, 0.3780487775803
1691     +, 0.6219512224197
1692     +, 0.7195121645927
1693     +, 0.7682926654816
1694     +, 0.8658536076546
1695     +, 0.9146341085434
1696     +, 0.9390243291855
1697     +, 0.000000000000
1698     +, 1.000000000000
1699     +, 0.5121951103210
1700     +/
1701     DATA SIGDEL / 0.4878048598766E-01
1702     +, 0.4878048598766E-01
1703     +, 0.4878048598766E-01
1704     +, 0.4878048598766E-01
1705     +, 0.4878048598766E-01
1706     +, 0.4878048598766E-01
1707     +, 0.4878048598766E-01
1708     +, 0.4878048598766E-01
1709     +, 0.4878048598766E-01
1710     +, 0.4878048598766E-01
1711     +, 0.4878048598766E-01
1712     +, 0.4878048598766E-01
1713     +, 0.1999999994950E-05
1714     +, 0.1999999994950E-05
1715     +, 0.9756097197533E-01
1716     +/
1717     DATA SIGA / 31.95672945139
1718     +, -34.23286209245
1719     +, -6.298459168211
1720     +, 10.98847700545
1721     +,-0.3052213535054
1722     +, 13.10517991464
1723     +, 15.60290821679
1724     +, -1.956118448507
1725     +, 12.41453816720
1726     +, -7.354056408553
1727     +, -32.32512668778
1728     +, 30.61116178966
1729     +, 1.418505329236
1730     +, 1.583492573619
1731     +, -18.48799977042
1732     +/
1733    
1734     V(1)=abs(x)
1735 pam-fi 1.9 if(V(1).gt.20.)V(1)=20.
1736 mocchiut 1.1
1737     HQUADF = 0.
1738     DO 20 J = 1, NPAR
1739     HQDJ = 0.
1740     DO 10 I = 1, NDIM
1741     VV = (V (I) - SIGVMI (I)) / SIGVT (I)
1742     HQDJ = HQDJ + (VV - SIGV (J, I)) ** 2
1743     10 CONTINUE
1744     HQDJ = HQDJ + SIGDEL (J) ** 2
1745     HQDJ = SQRT (HQDJ)
1746     HQUADF = HQUADF + SIGA (J) * HQDJ
1747     20 CONTINUE
1748     IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)
1749    
1750     risx_cog = HQUADF * 1e-4
1751    
1752     END
1753 pam-fi 1.16
1754    
1755     *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
1756     real function pfacorr(ic,angle) !(1)
1757     *--------------------------------------------------------------
1758     * this function returns the landi correction for this cluster
1759     *--------------------------------------------------------------
1760     include 'commontracker.f'
1761     include 'calib.f'
1762     include 'level1.f'
1763    
1764     real angle
1765     integer iview,lad
1766    
1767     iview = VIEW(ic)
1768     lad = nld(MAXS(ic),VIEW(ic))
1769    
1770     * find angular bin
1771     * (in futuro possiamo pensare di interpolare anche sull'angolo)
1772     do iang=1,nangbin
1773     if(angL(iang).lt.angle.and.angR(iang).ge.angle)then
1774     iangle=iang
1775     goto 98
1776     endif
1777     enddo
1778 pam-fi 1.18 if(DEBUG.eq.1)
1779 pam-fi 1.16 $ print*,'pfacorr *** warning *** angle out of range: ',angle
1780     if(angle.lt.angL(1))iang=1
1781     if(angle.gt.angR(nangbin))iang=nangbin
1782     98 continue !jump here if ok
1783    
1784     pfacorr = fcorr(iview,lad,iang)
1785    
1786 pam-fi 1.18 if(DEBUG.eq.1)print*,'CORR (ic ',ic,' ang',angle,') -->',pfacorr
1787 pam-fi 1.16
1788    
1789     100 return
1790     end

  ViewVC Help
Powered by ViewVC 1.1.23