1 |
pam-fi |
1.9 |
|
2 |
pam-fi |
1.10 |
|
3 |
|
|
subroutine idtoc(ipfa,cpfa) |
4 |
|
|
|
5 |
|
|
integer ipfa |
6 |
|
|
character*4 cpfa |
7 |
|
|
|
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 |
|
|
if(DEBUG) |
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 |
|
|
if(DEBUG)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 |
|
|
if(DEBUG) |
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 |
|
|
if(DEBUG)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 |
|
|
if(DEBUG) |
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 |
|
|
if(DEBUG)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 |
|
|
if(DEBUG) |
1779 |
|
|
$ 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 |
|
|
if(DEBUG)print*,'CORR (ic ',ic,' ang',angle,') -->',pfacorr |
1787 |
|
|
|
1788 |
|
|
|
1789 |
|
|
100 return |
1790 |
|
|
end |