1 |
************************************************************************ |
2 |
* |
3 |
* subroutine to evaluate the vector alfa (AL) |
4 |
* which minimizes CHI^2 |
5 |
* |
6 |
* - modified from mini.f in order to call differente chi^2 routine. |
7 |
* The new one includes also single clusters: in this case |
8 |
* the residual is defined as the distance between the track and the |
9 |
* segment AB associated to the single cluster. |
10 |
* |
11 |
* |
12 |
************************************************************************ |
13 |
|
14 |
|
15 |
SUBROUTINE MINIEXT(ISTEP,IFAIL,IPRINT) |
16 |
|
17 |
IMPLICIT DOUBLE PRECISION (A-H,O-Z) |
18 |
|
19 |
c include 'commontracker.f' !tracker general common |
20 |
include 'common_mini_ext.f' !common for the tracking procedure |
21 |
|
22 |
c logical DEBUG |
23 |
c common/dbg/DEBUG |
24 |
|
25 |
parameter (dinf=1.d15) !just a huge number... |
26 |
parameter (dinfneg=-dinf) ! just a huge negative number... |
27 |
c------------------------------------------------------------------------ |
28 |
c variables used in the tracking procedure (mini and its subroutines) |
29 |
c |
30 |
c N.B.: in mini & C. (and in the following block of variables too) |
31 |
c the plane ordering is reversed in respect of normal |
32 |
c ordering, but they maintain their Z coordinates. so plane number 1 is |
33 |
c the first one that a particle meets, and its Z coordinate is > 0 |
34 |
c------------------------------------------------------------------------ |
35 |
cc DATA ZINI/23.5/ !!! ***PP*** to be changed !z coordinate of the reference plane !!!Elena 2014 |
36 |
|
37 |
c DATA XGOOD,YGOOD/nextplanes*1.,nextplanes*1./ !planes to be used in the tracking |
38 |
|
39 |
DATA STEPAL/5*1.d-7/ !alpha vector step |
40 |
DATA ISTEPMAX/100/ !maximum number of steps in the chi^2 minimization |
41 |
DATA TOLL/1.d-8/ !tolerance in reaching the next plane during |
42 |
* !the tracking procedure |
43 |
DATA STEPMAX/100./ !maximum number of steps in the trackin gprocess |
44 |
|
45 |
c DATA ALMAX/dinf,dinf,1.,dinf,dinf/ !limits on alpha vector components |
46 |
c DATA ALMIN/-dinf,-dinf,-1.,-dinf,-dinf/ !" |
47 |
DATA ALMAX/dinf,dinf,1.,dinf,dinf/ !limits on alpha vector components |
48 |
DATA ALMIN/dinfneg,dinfneg,-1.,dinfneg,dinfneg/ !" |
49 |
|
50 |
c$$$ DIMENSION DAL(5) !increment of vector alfa |
51 |
DIMENSION CHI2DD_R(4,4),CHI2D_R(4) !hessiano e gradiente di chi2 |
52 |
|
53 |
c elena-------- |
54 |
REAL*8 AVRESX,AVRESY |
55 |
c elena-------- |
56 |
|
57 |
INTEGER IFLAG |
58 |
c-------------------------------------------------------- |
59 |
c IFLAG =1 ---- chi2 derivatives computed by using |
60 |
c incremental ratios and posxyz.f |
61 |
c IFLAG =2 ---- the approximation of Golden is used |
62 |
c (see chisq.f) |
63 |
c |
64 |
c NB: the two metods gives equivalent results BUT |
65 |
c method 2 is faster!! |
66 |
c-------------------------------------------------------- |
67 |
DATA IFLAG/2/ |
68 |
|
69 |
c LOGICAL TRKDEBUG,TRKVERBOSE |
70 |
c COMMON/TRKD/TRKDEBUG,TRKVERBOSE |
71 |
LOGICAL TRKDEBUG,TRKVERBOSE,STUDENT,FIRSTSTEPS,FIRSTSTUDENT |
72 |
COMMON/TRKD/TRKDEBUG,TRKVERBOSE |
73 |
|
74 |
DIMENSION AL0(5) |
75 |
LOGICAL SUCCESS_NEW,SUCCESS_OLD |
76 |
|
77 |
c$$$ PRINT*,'==========' ! TEST |
78 |
c$$$ PRINT*,'START MINI' ! TEST |
79 |
c$$$ PRINT*,'==========' ! TEST |
80 |
|
81 |
* |
82 |
* define kind of minimization (0x=chi2+gaussian or 1x=likelihood+student) |
83 |
* |
84 |
STUDENT = .false. |
85 |
FIRSTSTEPS = .true. |
86 |
FIRSTSTUDENT = .true. |
87 |
IF(MOD(INT(TRACKMODE/10),10).EQ.1) STUDENT = .true. |
88 |
|
89 |
IF(IPRINT.EQ.1) THEN |
90 |
TRKVERBOSE = .TRUE. |
91 |
TRKDEBUG = .FALSE. |
92 |
ELSEIF(IPRINT.EQ.2)THEN |
93 |
TRKVERBOSE = .TRUE. |
94 |
TRKDEBUG = .TRUE. |
95 |
ELSE |
96 |
TRKVERBOSE = .FALSE. |
97 |
TRKDEBUG = .FALSE. |
98 |
ENDIF |
99 |
|
100 |
* ---------------------------------------------------------- |
101 |
* evaluate average spatial resolution |
102 |
* ---------------------------------------------------------- |
103 |
AVRESX = RESXAV |
104 |
AVRESY = RESYAV |
105 |
c$$$ NX = 0 !EM GCC4.7 |
106 |
c$$$ NY = 0 !EM GCC4.7 |
107 |
c$$$ DO IP=1,NEXTPLANES |
108 |
c$$$ IF( XGOOD(IP).EQ.1 )THEN |
109 |
c$$$ NX=NX+1!EM GCC4.7 |
110 |
c$$$ AVRESX=AVRESX+RESX(IP) |
111 |
c$$$ ENDIF |
112 |
c$$$ IF( YGOOD(IP).EQ.1 )THEN |
113 |
c$$$ NY=NY+1!EM GCC4.7 |
114 |
c$$$ AVRESY=AVRESY+RESY(IP) |
115 |
c$$$ ENDIF |
116 |
c$$$ ENDDO |
117 |
c$$$ IF(NX.NE.0.0)AVRESX=AVRESX/NX |
118 |
c$$$ IF(NY.NE.0.0)AVRESY=AVRESY/NY |
119 |
|
120 |
DO IP=1,NEXTPLANES |
121 |
IF( XGOOD(IP).EQ.1 .AND. RESX(IP).LT.AVRESX)AVRESX=RESX(IP) |
122 |
IF( YGOOD(IP).EQ.1 .AND. RESY(IP).LT.AVRESY)AVRESY=RESY(IP) |
123 |
ENDDO |
124 |
|
125 |
* ---------------------------------------------------------- |
126 |
* define ALTOL(5) ---> tolerances on state vector |
127 |
* |
128 |
* ---------------------------------------------------------- |
129 |
* changed in order to evaluate energy-dependent |
130 |
* tolerances on all 5 parameters |
131 |
cPP FACT=1.0e10 !scale factor to define tolerance on alfa |
132 |
c deflection error (see PDG) |
133 |
DELETA1 = 0.01/0.3/0.4/0.4451**2*SQRT(720./(6.+4.)) |
134 |
DELETA2 = 0.016/0.3/0.4/0.4451*SQRT(0.4451/9.36) |
135 |
c$$$ ALTOL(1) = AVRESX/FACT !al(1) = x |
136 |
c$$$ ALTOL(2) = AVRESY/FACT !al(2) = y |
137 |
c$$$ ALTOL(3) = DSQRT(AVRESX**2 !al(3)=sin(theta) |
138 |
c$$$ $ +AVRESY**2)/44.51/FACT |
139 |
c$$$ ALTOL(4) = ALTOL(3) !al(4)=phi |
140 |
c deflection error (see PDG) |
141 |
c$$$ DELETA1 = 0.01*AVRESX/0.3/0.4/0.4451**2*SQRT(720./(6.+4.)) |
142 |
c$$$ DELETA2 = 0.016/0.3/0.4/0.4451*SQRT(0.4451/9.36) |
143 |
* ---------------------------------------------------------- |
144 |
* |
145 |
ISTEP=0 !num. steps to minimize chi^2 |
146 |
JFAIL=0 !error flag |
147 |
CHI2=0 |
148 |
|
149 |
if(TRKDEBUG)print*,'mini : guess ',al |
150 |
if(TRKDEBUG)print*,'mini : step ',istep,' chi2 ' |
151 |
$ ,chi2,' def ',AL(5) |
152 |
|
153 |
* |
154 |
* ----------------------- |
155 |
* START MINIMIZATION LOOP |
156 |
* ----------------------- |
157 |
10 ISTEP=ISTEP+1 !<<<<<<<<<<<<<< NEW STEP !! |
158 |
|
159 |
* ------------------------------- |
160 |
* **** Chi2+gaussian minimization |
161 |
* ------------------------------- |
162 |
|
163 |
IF((.NOT.STUDENT).OR.FIRSTSTEPS) THEN |
164 |
|
165 |
IF(ISTEP.GE.3) FIRSTSTEPS = .false. |
166 |
|
167 |
CALL CHISQEXT(IFLAG,JFAIL) !chi^2 and its derivatives |
168 |
IF(JFAIL.NE.0) THEN |
169 |
IFAIL=1 |
170 |
CHI2=-9999. |
171 |
if(TRKVERBOSE) |
172 |
$ PRINT *,'*** ERROR in mini *** wrong CHISQ' |
173 |
RETURN |
174 |
ENDIF |
175 |
|
176 |
c COST=1e-5 |
177 |
COST=1. |
178 |
DO I=1,5 |
179 |
IF(CHI2DD(I,I).NE.0.)COST=COST/DABS(CHI2DD(I,I))**0.2 |
180 |
ENDDO |
181 |
DO I=1,5 |
182 |
DO J=1,5 |
183 |
CHI2DD(I,J)=CHI2DD(I,J)*COST |
184 |
ENDDO |
185 |
c$$$ CHI2D(I)=CHI2D(I)*COST |
186 |
ENDDO |
187 |
|
188 |
IF(PFIXED.EQ.0.) THEN |
189 |
|
190 |
*------------------------------------------------------------* |
191 |
* track fitting with FREE deflection |
192 |
*------------------------------------------------------------* |
193 |
CALL DSFACT(5,CHI2DD,5,IFA,DET,JFA) !CHI2DD matrix determinant |
194 |
IF(IFA.NE.0) THEN !not positive-defined |
195 |
if(TRKVERBOSE)then |
196 |
PRINT *, |
197 |
$ '*** ERROR in mini ***'// |
198 |
$ 'on matrix inversion (not pos-def)' |
199 |
$ ,DET |
200 |
endif |
201 |
IF(CHI2.EQ.0) CHI2=-9999. |
202 |
IF(CHI2.GT.0) CHI2=-CHI2 |
203 |
IFAIL=1 |
204 |
RETURN |
205 |
ENDIF |
206 |
CALL DSFINV(5,CHI2DD,5) !CHI2DD matrix inversion |
207 |
* ******************************************* |
208 |
* find new value of AL-pha |
209 |
* ******************************************* |
210 |
DO I=1,5 |
211 |
DAL(I)=0. |
212 |
DO J=1,5 |
213 |
DAL(I)=DAL(I)-CHI2DD(I,J)*CHI2D(J) *COST |
214 |
COV(I,J)=2.*COST*CHI2DD(I,J) |
215 |
ENDDO |
216 |
ENDDO |
217 |
DO I=1,5 |
218 |
AL(I)=AL(I)+DAL(I) |
219 |
ENDDO |
220 |
*------------------------------------------------------------* |
221 |
* track fitting with FIXED deflection |
222 |
*------------------------------------------------------------* |
223 |
ELSE |
224 |
AL(5)=1./PFIXED |
225 |
DO I=1,4 |
226 |
CHI2D_R(I)=CHI2D(I) |
227 |
DO J=1,4 |
228 |
CHI2DD_R(I,J)=CHI2DD(I,J) |
229 |
ENDDO |
230 |
ENDDO |
231 |
CALL DSFACT(4,CHI2DD_R,4,IFA,DET,JFA) |
232 |
IF(IFA.NE.0) THEN |
233 |
if(TRKVERBOSE)then |
234 |
PRINT *, |
235 |
$ '*** ERROR in mini ***'// |
236 |
$ 'on matrix inversion (not pos-def)' |
237 |
$ ,DET |
238 |
endif |
239 |
IF(CHI2.EQ.0) CHI2=-9999. |
240 |
IF(CHI2.GT.0) CHI2=-CHI2 |
241 |
IFAIL=1 |
242 |
RETURN |
243 |
ENDIF |
244 |
CALL DSFINV(4,CHI2DD_R,4) |
245 |
* ******************************************* |
246 |
* find new value of AL-pha |
247 |
* ******************************************* |
248 |
DO I=1,4 |
249 |
DAL(I)=0. |
250 |
DO J=1,4 |
251 |
DAL(I)=DAL(I)-CHI2DD_R(I,J)*CHI2D_R(J) *COST |
252 |
COV(I,J)=2.*COST*CHI2DD_R(I,J) |
253 |
ENDDO |
254 |
ENDDO |
255 |
DAL(5)=0. |
256 |
DO I=1,4 |
257 |
AL(I)=AL(I)+DAL(I) |
258 |
ENDDO |
259 |
ENDIF |
260 |
|
261 |
cc if(TRKDEBUG) print*,'mini : step ',istep,chi2,AL(5) |
262 |
if(TRKDEBUG)print*,'mini : step ',istep,' chi2 ' |
263 |
$ ,chi2,' def ',AL(5) |
264 |
|
265 |
c$$$ PRINT*,'DAL ',(DAL(K),K=1,5) |
266 |
c$$$ PRINT*,'CHI2DOLD ',(CHI2DOLD(K),K=1,5) |
267 |
|
268 |
|
269 |
ENDIF |
270 |
|
271 |
* ------------------------------- |
272 |
* **** Likelihood+Student minimization |
273 |
* ------------------------------- |
274 |
|
275 |
IF(STUDENT.AND.(.NOT.FIRSTSTEPS)) THEN |
276 |
|
277 |
IF(FIRSTSTUDENT) THEN |
278 |
FIRSTSTUDENT = .false. |
279 |
ISTEP = 1 |
280 |
ENDIF |
281 |
|
282 |
CALL CHISQSTTEXT(1,JFAIL) |
283 |
DO I=1,5 |
284 |
DAL(I)=0. |
285 |
DO J=1,5 |
286 |
DAL(I)=DAL(I)-CHI2DD(I,J)*CHI2D(J) |
287 |
ENDDO |
288 |
ENDDO |
289 |
|
290 |
DO I=1,5 |
291 |
DO j=1,5 |
292 |
COV(I,J) = 2.*CHI2DD(I,J) |
293 |
ENDDO |
294 |
ENDDO |
295 |
|
296 |
CHI2TOLL = 1.E-3 |
297 |
ALPHA = 3.0 |
298 |
BETA = -0.4 |
299 |
E=1. |
300 |
EA=1. |
301 |
EB=1. |
302 |
EC=1. |
303 |
FA=1. |
304 |
FB=1. |
305 |
FC=1. |
306 |
SUCCESS_OLD = .FALSE. |
307 |
SUCCESS_NEW = .FALSE. |
308 |
|
309 |
CALL CHISQSTTEXT(0,JFAIL) |
310 |
c$$$ PRINT*,CHI2 |
311 |
CHI2_NEW = CHI2 |
312 |
FC = CHI2 |
313 |
EC = 0. |
314 |
|
315 |
ICOUNT = 0 |
316 |
100 CONTINUE |
317 |
ICOUNT = ICOUNT+1 |
318 |
|
319 |
DO I=1,5 |
320 |
AL0(I)=AL(I) |
321 |
ENDDO |
322 |
DO I=1,5 |
323 |
AL(I)=AL(I)+E*DAL(I) |
324 |
ENDDO |
325 |
CALL CHISQSTTEXT(0,JFAIL) |
326 |
CHI2_OLD = CHI2_NEW |
327 |
CHI2_NEW = CHI2 |
328 |
FA = FB |
329 |
FB = FC |
330 |
FC = CHI2 |
331 |
EA = EB |
332 |
EB = EC |
333 |
EC = E |
334 |
|
335 |
c$$$ PRINT*,E,CHI2_NEW |
336 |
|
337 |
IF(CHI2_NEW.LE.CHI2_OLD) THEN ! success |
338 |
IF(DABS(CHI2_NEW-CHI2_OLD).LT.CHI2TOLL) GOTO 101 |
339 |
SUCCESS_OLD = SUCCESS_NEW |
340 |
SUCCESS_NEW = .TRUE. |
341 |
E = E*ALPHA |
342 |
ELSE ! failure |
343 |
SUCCESS_OLD = SUCCESS_NEW |
344 |
SUCCESS_NEW = .FALSE. |
345 |
CHI2_NEW = CHI2_OLD |
346 |
DO I=1,5 |
347 |
AL(I)=AL0(I) |
348 |
ENDDO |
349 |
IF(SUCCESS_OLD) THEN |
350 |
DENOM = (EB-EA)*(FB-FC) - (EB-EC)*(FB-FA) |
351 |
IF(DENOM.NE.0.) THEN |
352 |
E = EB - 0.5*( (EB-EA)**2*(FB-FC) |
353 |
$ - (EB-EC)**2*(FB-FA) ) / DENOM |
354 |
ELSE |
355 |
E = BETA*E |
356 |
ENDIF |
357 |
ELSE |
358 |
E = BETA*E |
359 |
ENDIF |
360 |
c$$$ E = BETA*E |
361 |
ENDIF |
362 |
IF(ICOUNT.GT.20) GOTO 101 |
363 |
GOTO 100 |
364 |
|
365 |
101 CONTINUE |
366 |
|
367 |
DO I=1,5 |
368 |
DAL(I)=E*DAL(I) |
369 |
ENDDO |
370 |
|
371 |
c$$$ print*,' ' |
372 |
c$$$ PRINT*,'DAL ',(DAL(K),K=1,5) |
373 |
c$$$ PRINT*,'CHI2DOLD ',(CHI2DOLD(K),K=1,5) |
374 |
c$$$ print*,'==== CHI2 ====' |
375 |
c$$$ print*,chi2 |
376 |
c$$$ print*,'==== CHI2d ====' |
377 |
c$$$ print*,(chi2d(i),i=1,5) |
378 |
c$$$ print*,'==== CHI2dd ====' |
379 |
c$$$ do j=1,5 |
380 |
c$$$ print*,(chi2dd(j,i),i=1,5) |
381 |
c$$$ enddo |
382 |
c$$$ print*,'================' |
383 |
c$$$ print*,' ' |
384 |
|
385 |
*========= FIN QUI ============= |
386 |
|
387 |
ENDIF |
388 |
|
389 |
|
390 |
|
391 |
|
392 |
|
393 |
*------------------------------------------------------------* |
394 |
* ---------------------------------------------------- * |
395 |
*------------------------------------------------------------* |
396 |
* check parameter bounds: |
397 |
*------------------------------------------------------------* |
398 |
DO I=1,5 |
399 |
IF(AL(I).GT.ALMAX(I).OR.AL(I).LT.ALMIN(I))THEN |
400 |
if(TRKVERBOSE)then |
401 |
PRINT*,' *** WARNING in mini *** ' |
402 |
PRINT*,'MINI_2 ==> AL(',I,') out of range' |
403 |
PRINT*,' value: ',AL(I), |
404 |
$ ' limits: ',ALMIN(I),ALMAX(I) |
405 |
print*,'istep ',istep |
406 |
endif |
407 |
IF(CHI2.EQ.0) CHI2=-9999. |
408 |
IF(CHI2.GT.0) CHI2=-CHI2 |
409 |
IFAIL=1 |
410 |
RETURN |
411 |
ENDIF |
412 |
ENDDO |
413 |
*------------------------------------------------------------* |
414 |
* check number of steps: |
415 |
*------------------------------------------------------------* |
416 |
IF(ISTEP.ge.ISTEPMAX) then |
417 |
c$$$ IFAIL=1 |
418 |
c$$$ if(TRKVERBOSE) |
419 |
c$$$ $ PRINT *,'*** WARNING in mini *** ISTEP.GT.ISTEPMAX=', |
420 |
c$$$ $ ISTEPMAX |
421 |
goto 11 |
422 |
endif |
423 |
*------------------------------------------------------------* |
424 |
* --------------------------------------------- |
425 |
* evaluate deflection tolerance on the basis of |
426 |
* estimated deflection |
427 |
* --------------------------------------------- |
428 |
*------------------------------------------------------------* |
429 |
c$$$ ALTOL(5) = DSQRT(DELETA1**2+DELETA2**2*AL(5)**2)/FACT |
430 |
IF(FACT.EQ.0)THEN |
431 |
IFAIL=1 |
432 |
RETURN |
433 |
ENDIF |
434 |
ALTOL(5) = DSQRT((DELETA1*AVRESX)**2+DELETA2**2*AL(5)**2)/FACT |
435 |
ALTOL(1) = ALTOL(5)/DELETA1 |
436 |
ALTOL(2) = ALTOL(1) |
437 |
ALTOL(3) = DSQRT(ALTOL(1)**2+ALTOL(2)**2)/44.51 |
438 |
ALTOL(4) = ALTOL(3) |
439 |
|
440 |
c$$$ print*,' -- ',(DAL(I),ALTOL(I),' - ',i=1,5) !>>>> new step! |
441 |
|
442 |
*---- check tolerances: |
443 |
c$$$ DO I=1,5 |
444 |
c$$$ if(TRKVERBOSE)print*,i,' -- ',DAL(I),ALTOL(I) !>>>> new step! |
445 |
c$$$ ENDDO |
446 |
c$$$ print*,'chi2 -- ',DCHI2 |
447 |
|
448 |
IF(ISTEP.LT.ISTEPMIN) GOTO 10 ! ***PP*** |
449 |
DO I=1,5 |
450 |
IF(ABS(DAL(I)).GT.ALTOL(I))GOTO 10 !>>>> new step! |
451 |
ENDDO |
452 |
|
453 |
***************************** |
454 |
* final estimate of chi^2 |
455 |
***************************** |
456 |
|
457 |
* ------------------------------- |
458 |
* **** Chi2+gaussian minimization |
459 |
* ------------------------------- |
460 |
|
461 |
IF(.NOT.STUDENT) THEN |
462 |
|
463 |
JFAIL=0 !error flag |
464 |
CALL CHISQEXT(IFLAG,JFAIL) !chi^2 and its derivatives |
465 |
IF(JFAIL.NE.0) THEN |
466 |
IFAIL=1 |
467 |
if(TRKVERBOSE)THEN |
468 |
CHI2=-9999. |
469 |
if(TRKVERBOSE) |
470 |
$ PRINT *,'*** ERROR in mini *** wrong CHISQ' |
471 |
ENDIF |
472 |
RETURN |
473 |
ENDIF |
474 |
c COST=1e-7 |
475 |
COST=1. |
476 |
DO I=1,5 |
477 |
IF(CHI2DD(I,I).NE.0.)COST=COST/DABS(CHI2DD(I,I))**0.2 |
478 |
ENDDO |
479 |
DO I=1,5 |
480 |
DO J=1,5 |
481 |
CHI2DD(I,J)=CHI2DD(I,J)*COST |
482 |
ENDDO |
483 |
ENDDO |
484 |
IF(PFIXED.EQ.0.) THEN |
485 |
CALL DSFACT(5,CHI2DD,5,IFA,DET,JFA) !CHI2DD matrix determinant |
486 |
IF(IFA.NE.0) THEN !not positive-defined |
487 |
if(TRKVERBOSE)then |
488 |
PRINT *, |
489 |
$ '*** ERROR in mini ***'// |
490 |
$ 'on matrix inversion (not pos-def)' |
491 |
$ ,DET |
492 |
endif |
493 |
IF(CHI2.EQ.0) CHI2=-9999. |
494 |
IF(CHI2.GT.0) CHI2=-CHI2 |
495 |
IFAIL=1 |
496 |
RETURN |
497 |
ENDIF |
498 |
CALL DSFINV(5,CHI2DD,5) !CHI2DD matrix inversion |
499 |
DO I=1,5 |
500 |
c$$$ DAL(I)=0. |
501 |
DO J=1,5 |
502 |
COV(I,J)=2.*COST*CHI2DD(I,J) |
503 |
ENDDO |
504 |
ENDDO |
505 |
ELSE |
506 |
DO I=1,4 |
507 |
CHI2D_R(I)=CHI2D(I) |
508 |
DO J=1,4 |
509 |
CHI2DD_R(I,J)=CHI2DD(I,J) |
510 |
ENDDO |
511 |
ENDDO |
512 |
CALL DSFACT(4,CHI2DD_R,4,IFA,DET,JFA) |
513 |
IF(IFA.NE.0) THEN |
514 |
if(TRKVERBOSE)then |
515 |
PRINT *, |
516 |
$ '*** ERROR in mini ***'// |
517 |
$ 'on matrix inversion (not pos-def)' |
518 |
$ ,DET |
519 |
endif |
520 |
IF(CHI2.EQ.0) CHI2=-9999. |
521 |
IF(CHI2.GT.0) CHI2=-CHI2 |
522 |
IFAIL=1 |
523 |
RETURN |
524 |
ENDIF |
525 |
CALL DSFINV(4,CHI2DD_R,4) |
526 |
DO I=1,4 |
527 |
c$$$ DAL(I)=0. |
528 |
DO J=1,4 |
529 |
COV(I,J)=2.*COST*CHI2DD_R(I,J) |
530 |
ENDDO |
531 |
ENDDO |
532 |
ENDIF |
533 |
|
534 |
ENDIF |
535 |
|
536 |
* ------------------------------- |
537 |
* **** Likelihood+student minimization |
538 |
* ------------------------------- |
539 |
|
540 |
IF(STUDENT) THEN |
541 |
CALL CHISQSTTEXT(1,JFAIL) |
542 |
DO I=1,5 |
543 |
DO j=1,5 |
544 |
COV(I,J) = 2.*CHI2DD(I,J) |
545 |
ENDDO |
546 |
ENDDO |
547 |
ENDIF |
548 |
|
549 |
***************************** |
550 |
|
551 |
* ------------------------------------ |
552 |
* Number of Degree Of Freedom |
553 |
ndof=0 |
554 |
do ip=1,nextplanes |
555 |
ndof=ndof |
556 |
$ +int(xgood(ip)) |
557 |
$ +int(ygood(ip)) |
558 |
enddo |
559 |
if(pfixed.eq.0.) ndof=ndof-5 ! ***PP*** |
560 |
if(pfixed.ne.0.) ndof=ndof-4 ! ***PP*** |
561 |
if(ndof.le.0.) then |
562 |
ndof = 1 |
563 |
if(TRKVERBOSE) |
564 |
$ print*,'*** WARNING *** in mini n.dof = 0 (set to 1)' |
565 |
endif |
566 |
|
567 |
* ------------------------------------ |
568 |
* Reduced chi^2 |
569 |
CHI2 = CHI2/dble(ndof) |
570 |
c print*,'mini2: chi2 ',chi2 |
571 |
|
572 |
11 CONTINUE |
573 |
|
574 |
if(TRKDEBUG) print*,'mini : -ok- ',istep,chi2,AL(5) |
575 |
|
576 |
NSTEP=ISTEP ! ***PP*** |
577 |
|
578 |
c$$$ print*,'>>>>> NSTEP = ',NSTEP |
579 |
|
580 |
RETURN |
581 |
END |
582 |
|
583 |
****************************************************************************** |
584 |
* |
585 |
* routine to compute chi^2 and its derivatives |
586 |
* |
587 |
* |
588 |
* (modified in respect to the previous one in order to include |
589 |
* single clusters. In this case the residual is evaluated by |
590 |
* calculating the distance between the track intersection and the |
591 |
* segment AB associated to the single cluster) |
592 |
* |
593 |
****************************************************************************** |
594 |
|
595 |
SUBROUTINE CHISQEXT(IFLAG,IFAIL) |
596 |
|
597 |
IMPLICIT DOUBLE PRECISION (A-H,O-Z) |
598 |
|
599 |
c include 'commontracker.f' !tracker general common |
600 |
include 'common_mini_ext.f' !common for the tracking procedure |
601 |
|
602 |
DIMENSION XV2(nextplanes),YV2(nextplanes) |
603 |
$ ,XV1(nextplanes),YV1(nextplanes) |
604 |
$ ,XV0(nextplanes),YV0(nextplanes) |
605 |
DIMENSION AL_P(5) |
606 |
|
607 |
c LOGICAL TRKVERBOSE |
608 |
c COMMON/TRKD/TRKVERBOSE |
609 |
LOGICAL TRKDEBUG,TRKVERBOSE |
610 |
COMMON/TRKD/TRKDEBUG,TRKVERBOSE |
611 |
* |
612 |
* chi^2 computation |
613 |
* |
614 |
DO I=1,5 |
615 |
AL_P(I)=AL(I) |
616 |
ENDDO |
617 |
JFAIL=0 !error flag |
618 |
CALL POSXYZEXT(AL_P,JFAIL) !track intersection with tracking planes |
619 |
IF(JFAIL.NE.0) THEN |
620 |
IF(TRKVERBOSE) |
621 |
$ PRINT *,'CHISQEXT ==> error from trk routine POSXYZEXT !!' |
622 |
IFAIL=1 |
623 |
RETURN |
624 |
ENDIF |
625 |
DO I=1,nextplanes |
626 |
XV0(I)=XV(I) |
627 |
YV0(I)=YV(I) |
628 |
ENDDO |
629 |
* ------------------------------------------------ |
630 |
c$$$ CHI2=0. |
631 |
c$$$ DO I=1,nextplanes |
632 |
c$$$ CHI2=CHI2 |
633 |
c$$$ + +(XV(I)-XM(I))**2/RESX(i)**2 *XGOOD(I)*YGOOD(I) |
634 |
c$$$ + +(YV(I)-YM(I))**2/RESY(i)**2 *YGOOD(I)*XGOOD(I) |
635 |
c$$$ ENDDO |
636 |
* --------------------------------------------------------- |
637 |
* For planes with only a X or Y-cl included, instead of |
638 |
* a X-Y couple, the residual for chi^2 calculation is |
639 |
* evaluated by finding the point x-y, along the segment AB, |
640 |
* closest to the track. |
641 |
* The X or Y coordinate, respectivelly for X and Y-cl, is |
642 |
* then assigned to XM or YM, which is then considered the |
643 |
* measured position of the cluster. |
644 |
* --------------------------------------------------------- |
645 |
CHI2=0. |
646 |
DO I=1,nextplanes |
647 |
IF(XGOOD(I).EQ.1.AND.YGOOD(I).EQ.0)THEN !X-cl |
648 |
BETA = (XM_B(I)-XM_A(I))/(YM_B(I)-YM_A(I)) |
649 |
ALFA = XM_A(I) - BETA * YM_A(I) |
650 |
YM(I) = ( YV(I) + BETA*XV(I) - BETA*ALFA )/(1+BETA**2) |
651 |
if(YM(I).lt.dmin1(YM_A(I),YM_B(I))) |
652 |
$ YM(I)=dmin1(YM_A(I),YM_B(I)) |
653 |
if(YM(I).gt.dmax1(YM_A(I),YM_B(I))) |
654 |
$ YM(I)=dmax1(YM_A(I),YM_B(I)) |
655 |
XM(I) = ALFA + BETA * YM(I) !<<<< measured coordinates |
656 |
ZM(I) = ZM_A(I) + |
657 |
$ (ZM_B(I)-ZM_A(I))*(YM(I)-YM_A(I))/(YM_B(I)-YM_A(I)) |
658 |
ELSEIF(XGOOD(I).EQ.0.AND.YGOOD(I).EQ.1)THEN !Y-cl |
659 |
BETA = (YM_B(I)-YM_A(I))/(XM_B(I)-XM_A(I)) |
660 |
ALFA = YM_A(I) - BETA * XM_A(I) |
661 |
XM(I) = ( XV(I) + BETA*YV(I) - BETA*ALFA )/(1+BETA**2) |
662 |
if(XM(I).lt.dmin1(XM_A(I),XM_B(I))) |
663 |
$ XM(I)=dmin1(XM_A(I),XM_B(I)) |
664 |
if(XM(I).gt.dmax1(XM_A(I),XM_B(I))) |
665 |
$ XM(I)=dmax1(XM_A(I),XM_B(I)) |
666 |
YM(I) = ALFA + BETA * XM(I) !<<<< measured coordinates |
667 |
ZM(I) = ZM_A(I) + |
668 |
$ (ZM_B(I)-ZM_A(I))*(XM(I)-XM_A(I))/(XM_B(I)-XM_A(I)) |
669 |
ENDIF |
670 |
CHI2=CHI2 |
671 |
+ +(XV(I)-XM(I))**2/RESX(i)**2 *( XGOOD(I)*YGOOD(I) ) |
672 |
+ +(YV(I)-YM(I))**2/RESY(i)**2 *( YGOOD(I)*XGOOD(I) ) |
673 |
+ +((XV(I)-XM(I))**2+(YV(I)-YM(I))**2)/RESX(i)**2 |
674 |
+ *( XGOOD(I)*(1-YGOOD(I)) ) |
675 |
+ +((XV(I)-XM(I))**2+(YV(I)-YM(I))**2)/RESY(i)**2 |
676 |
+ *( (1-XGOOD(I))*YGOOD(I) ) |
677 |
c$$$ print*,(XV(I)-XM(I))**2/RESX(i)**2 *( XGOOD(I)*YGOOD(I) ) |
678 |
c$$$ print*,(YV(I)-YM(I))**2/RESY(i)**2 *( YGOOD(I)*XGOOD(I) ) |
679 |
c$$$ print*,((XV(I)-XM(I))**2+(YV(I)-YM(I))**2)/RESX(i)**2 |
680 |
c$$$ + *( XGOOD(I)*(1-YGOOD(I)) ) |
681 |
c$$$ print*,((XV(I)-XM(I))**2+(YV(I)-YM(I))**2)/RESY(i)**2 |
682 |
c$$$ + *( (1-XGOOD(I))*YGOOD(I) ) |
683 |
c$$$ print*,XV(I),XM(I),XGOOD(I) |
684 |
c$$$ print*,YV(I),YM(I),YGOOD(I) |
685 |
ENDDO |
686 |
if(TRKDEBUG)print*,'CHISQ ',chi2 |
687 |
* ------------------------------------------------ |
688 |
* |
689 |
* calculation of derivatives (dX/dAL_fa and dY/dAL_fa) |
690 |
* |
691 |
* ////////////////////////////////////////////////// |
692 |
* METHOD 1 -- incremental ratios |
693 |
* ////////////////////////////////////////////////// |
694 |
|
695 |
IF(IFLAG.EQ.1) THEN |
696 |
|
697 |
DO J=1,5 |
698 |
DO JJ=1,5 |
699 |
AL_P(JJ)=AL(JJ) |
700 |
ENDDO |
701 |
AL_P(J)=AL_P(J)+STEPAL(J)/2. |
702 |
JFAIL=0 |
703 |
CALL POSXYZEXT(AL_P,JFAIL) |
704 |
IF(JFAIL.NE.0) THEN |
705 |
IF(TRKVERBOSE) |
706 |
*23456789012345678901234567890123456789012345678901234567890123456789012 |
707 |
$ PRINT *, |
708 |
$ 'CHISQEXT ==> error from trk routine POSXYZEXT' |
709 |
IFAIL=1 |
710 |
RETURN |
711 |
ENDIF |
712 |
DO I=1,nextplanes |
713 |
XV2(I)=XV(I) |
714 |
YV2(I)=YV(I) |
715 |
ENDDO |
716 |
AL_P(J)=AL_P(J)-STEPAL(J) |
717 |
JFAIL=0 |
718 |
CALL POSXYZEXT(AL_P,JFAIL) |
719 |
IF(JFAIL.NE.0) THEN |
720 |
IF(TRKVERBOSE) |
721 |
$ PRINT *, |
722 |
$ 'CHISQEXT ==> error from trk routine POSXYZEXT' |
723 |
IFAIL=1 |
724 |
RETURN |
725 |
ENDIF |
726 |
DO I=1,nextplanes |
727 |
XV1(I)=XV(I) |
728 |
YV1(I)=YV(I) |
729 |
ENDDO |
730 |
DO I=1,nextplanes |
731 |
DXDAL(I,J)=(XV2(I)-XV1(I))/STEPAL(J) |
732 |
DYDAL(I,J)=(YV2(I)-YV1(I))/STEPAL(J) |
733 |
ENDDO |
734 |
ENDDO |
735 |
|
736 |
ENDIF |
737 |
|
738 |
* ////////////////////////////////////////////////// |
739 |
* METHOD 2 -- Bob Golden |
740 |
* ////////////////////////////////////////////////// |
741 |
|
742 |
IF(IFLAG.EQ.2) THEN |
743 |
|
744 |
DO I=1,nextplanes |
745 |
DXDAL(I,1)=1. |
746 |
DYDAL(I,1)=0. |
747 |
|
748 |
DXDAL(I,2)=0. |
749 |
DYDAL(I,2)=1. |
750 |
|
751 |
COSTHE=DSQRT(1.-AL(3)**2) |
752 |
IF(COSTHE.EQ.0.) THEN |
753 |
IF(TRKVERBOSE)PRINT *,'=== WARNING ===> COSTHE=0' |
754 |
IFAIL=1 |
755 |
RETURN |
756 |
ENDIF |
757 |
|
758 |
DXDAL(I,3)=(ZINI-ZM(I))*DCOS(AL(4))/COSTHE**3 |
759 |
DYDAL(I,3)=(ZINI-ZM(I))*DSIN(AL(4))/COSTHE**3 |
760 |
|
761 |
DXDAL(I,4)=-AL(3)*(ZINI-ZM(I))*DSIN(AL(4))/COSTHE |
762 |
DYDAL(I,4)=AL(3)*(ZINI-ZM(I))*DCOS(AL(4))/COSTHE |
763 |
|
764 |
IF(AL(5).NE.0.) THEN |
765 |
DXDAL(I,5)= |
766 |
+ (XV(I)-(AL(1)+AL(3)/COSTHE*(ZINI-ZM(I)) |
767 |
+ *DCOS(AL(4))))/AL(5) |
768 |
DYDAL(I,5)= |
769 |
+ (YV(I)-(AL(2)+AL(3)/COSTHE*(ZINI-ZM(I)) |
770 |
+ *DSIN(AL(4))))/AL(5) |
771 |
ELSE |
772 |
DXDAL(I,5)=100.*( 0.25 *0.3*0.4*(0.01*(ZINI-ZM(I)))**2 ) |
773 |
DYDAL(I,5)=0. |
774 |
ENDIF |
775 |
|
776 |
ENDDO |
777 |
ENDIF |
778 |
* |
779 |
* x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x |
780 |
* >>> CHI2D evaluation |
781 |
* |
782 |
DO J=1,5 |
783 |
CHI2D(J)=0. |
784 |
DO I=1,nextplanes |
785 |
CHI2D(J)=CHI2D(J) |
786 |
+ +2.*(XV0(I)-XM(I))/RESX(i)**2*DXDAL(I,J) *XGOOD(I) |
787 |
+ +2.*(YV0(I)-YM(I))/RESY(i)**2*DYDAL(I,J) *YGOOD(I) |
788 |
ENDDO |
789 |
ENDDO |
790 |
* |
791 |
* >>> CHI2DD evaluation |
792 |
* |
793 |
DO I=1,5 |
794 |
DO J=1,5 |
795 |
CHI2DD(I,J)=0. |
796 |
DO K=1,nextplanes |
797 |
CHI2DD(I,J)=CHI2DD(I,J) |
798 |
+ +2.*DXDAL(K,I)*DXDAL(K,J)/RESX(k)**2 *XGOOD(K) |
799 |
+ +2.*DYDAL(K,I)*DYDAL(K,J)/RESY(k)**2 *YGOOD(K) |
800 |
ENDDO |
801 |
ENDDO |
802 |
ENDDO |
803 |
* x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x |
804 |
|
805 |
RETURN |
806 |
END |
807 |
|
808 |
****************************************************************************** |
809 |
* |
810 |
* routine to compute Likelihodd+Student and its derivatives |
811 |
* |
812 |
* (modified in respect to the previous one in order to include |
813 |
* single clusters. In this case the residual is evaluated by |
814 |
* calculating the distance between the track intersection and the |
815 |
* segment AB associated to the single cluster) |
816 |
* |
817 |
****************************************************************************** |
818 |
|
819 |
SUBROUTINE CHISQSTTEXT(IFLAG,JFAIL) |
820 |
|
821 |
IMPLICIT DOUBLE PRECISION (A-H,O-Z) |
822 |
|
823 |
c include 'commontracker.f' !tracker general common |
824 |
include 'common_mini_ext.f' !common for the tracking procedure |
825 |
|
826 |
LOGICAL TRKDEBUG,TRKVERBOSE |
827 |
COMMON/TRKD/TRKDEBUG,TRKVERBOSE |
828 |
|
829 |
DIMENSION AL_P(5) |
830 |
DIMENSION VECTEMP(5) |
831 |
c$$$ DIMENSION U(5) ! BFGS |
832 |
|
833 |
DO I=1,5 |
834 |
AL_P(I)=AL(I) |
835 |
ENDDO |
836 |
JFAIL=0 !error flag |
837 |
CALL POSXYZEXT(AL_P,JFAIL) !track intersection with tracking planes |
838 |
IF(JFAIL.NE.0) THEN |
839 |
IF(TRKVERBOSE) |
840 |
$ PRINT *, |
841 |
$ 'CHISQSTTEXT ==> error from trk routine POSXYZEXT !!' |
842 |
IFAIL=1 |
843 |
RETURN |
844 |
ENDIF |
845 |
|
846 |
DO I=1,nextplanes |
847 |
DXDAL(I,1)=1. |
848 |
DYDAL(I,1)=0. |
849 |
DXDAL(I,2)=0. |
850 |
DYDAL(I,2)=1. |
851 |
COSTHE=DSQRT(1.-AL(3)**2) |
852 |
IF(COSTHE.EQ.0.) THEN |
853 |
IF(TRKVERBOSE)PRINT *,'=== WARNING ===> COSTHE=0' |
854 |
IFAIL=1 |
855 |
RETURN |
856 |
ENDIF |
857 |
DXDAL(I,3)=(ZINI-ZM(I))*DCOS(AL(4))/COSTHE**3 |
858 |
DYDAL(I,3)=(ZINI-ZM(I))*DSIN(AL(4))/COSTHE**3 |
859 |
DXDAL(I,4)=-AL(3)*(ZINI-ZM(I))*DSIN(AL(4))/COSTHE |
860 |
DYDAL(I,4)=AL(3)*(ZINI-ZM(I))*DCOS(AL(4))/COSTHE |
861 |
IF(AL(5).NE.0.) THEN |
862 |
DXDAL(I,5)= |
863 |
+ (XV(I)-(AL(1)+AL(3)/COSTHE*(ZINI-ZM(I)) |
864 |
+ *DCOS(AL(4))))/AL(5) |
865 |
DYDAL(I,5)= |
866 |
+ (YV(I)-(AL(2)+AL(3)/COSTHE*(ZINI-ZM(I)) |
867 |
+ *DSIN(AL(4))))/AL(5) |
868 |
ELSE |
869 |
DXDAL(I,5)=100.*( 0.25 *0.3*0.4*(0.01*(ZINI-ZM(I)))**2 ) |
870 |
DYDAL(I,5)=0. |
871 |
ENDIF |
872 |
ENDDO |
873 |
|
874 |
IF(IFLAG.EQ.0) THEN ! function calulation |
875 |
CHI2=0. |
876 |
DO I=1,nextplanes |
877 |
IF(XGOOD(I).EQ.1.AND.YGOOD(I).EQ.0)THEN !X-cl |
878 |
BETA = (XM_B(I)-XM_A(I))/(YM_B(I)-YM_A(I)) |
879 |
ALFA = XM_A(I) - BETA * YM_A(I) |
880 |
YM(I) = ( YV(I) + BETA*XV(I) - BETA*ALFA )/(1+BETA**2) |
881 |
if(YM(I).lt.dmin1(YM_A(I),YM_B(I))) |
882 |
$ YM(I)=dmin1(YM_A(I),YM_B(I)) |
883 |
if(YM(I).gt.dmax1(YM_A(I),YM_B(I))) |
884 |
$ YM(I)=dmax1(YM_A(I),YM_B(I)) |
885 |
XM(I) = ALFA + BETA * YM(I) !<<<< measured coordinates |
886 |
ELSEIF(XGOOD(I).EQ.0.AND.YGOOD(I).EQ.1)THEN !Y-cl |
887 |
BETA = (YM_B(I)-YM_A(I))/(XM_B(I)-XM_A(I)) |
888 |
ALFA = YM_A(I) - BETA * XM_A(I) |
889 |
XM(I) = ( XV(I) + BETA*YV(I) - BETA*ALFA )/(1+BETA**2) |
890 |
if(XM(I).lt.dmin1(XM_A(I),XM_B(I))) |
891 |
$ XM(I)=dmin1(XM_A(I),XM_B(I)) |
892 |
if(XM(I).gt.dmax1(XM_A(I),XM_B(I))) |
893 |
$ XM(I)=dmax1(XM_A(I),XM_B(I)) |
894 |
YM(I) = ALFA + BETA * XM(I) !<<<< measured coordinates |
895 |
ENDIF |
896 |
TERMX = DLOG( (TAILX(I)*RESX(I)**2+(XV(I)-XM(I))**2)/ |
897 |
$ (TAILX(I)*RESX(I)**2) ) |
898 |
TERMY = DLOG( (TAILY(I)*RESY(I)**2+(YV(I)-YM(I))**2)/ |
899 |
$ (TAILY(I)*RESY(I)**2) ) |
900 |
CHI2=CHI2 |
901 |
$ +(TAILX(I)+1.0)*TERMX *( XGOOD(I) ) |
902 |
$ +(TAILY(I)+1.0)*TERMY *( YGOOD(I) ) |
903 |
ENDDO |
904 |
ENDIF |
905 |
|
906 |
IF(IFLAG.EQ.1) THEN ! derivative calulation |
907 |
DO I=1,5 |
908 |
CHI2DOLD(I)=CHI2D(I) |
909 |
ENDDO |
910 |
DO J=1,5 |
911 |
CHI2D(J)=0. |
912 |
DO I=1,nextplanes |
913 |
CHI2D(J)=CHI2D(J) |
914 |
$ +2.*(TAILX(I)+1.0)*(XV(I)-XM(I))/ |
915 |
$ (TAILX(I)*RESX(I)**2+(XV(I)-XM(I))**2)* |
916 |
$ DXDAL(I,J) *XGOOD(I) |
917 |
$ +2.*(TAILY(I)+1.0)*(YV(I)-YM(I))/ |
918 |
$ (TAILY(I)*RESY(I)**2+(YV(I)-YM(I))**2)* |
919 |
$ DYDAL(I,J) *YGOOD(I) |
920 |
ENDDO |
921 |
ENDDO |
922 |
DO K=1,5 |
923 |
VECTEMP(K)=0. |
924 |
DO M=1,5 |
925 |
VECTEMP(K) = VECTEMP(K) + |
926 |
$ COV(K,M)/2.*(CHI2D(M)-CHI2DOLD(M)) |
927 |
ENDDO |
928 |
ENDDO |
929 |
DOWN1 = 0. |
930 |
DO K=1,5 |
931 |
DOWN1 = DOWN1 + DAL(K)*(CHI2D(K)-CHI2DOLD(K)) |
932 |
ENDDO |
933 |
IF(DOWN1.EQ.0.) THEN |
934 |
PRINT*,'WARNING IN MATRIX CALULATION (STUDENT), DOWN1 = 0' |
935 |
IFAIL=1 |
936 |
RETURN |
937 |
ENDIF |
938 |
DOWN2 = 0. |
939 |
DO K=1,5 |
940 |
DO M=1,5 |
941 |
DOWN2 = DOWN2 + (CHI2D(K)-CHI2DOLD(K))*VECTEMP(K) |
942 |
ENDDO |
943 |
ENDDO |
944 |
IF(DOWN2.EQ.0.) THEN |
945 |
PRINT*,'WARNING IN MATRIX CALULATION (STUDENT), DOWN2 = 0' |
946 |
IFAIL=1 |
947 |
RETURN |
948 |
ENDIF |
949 |
c$$$ DO K=1,5 ! BFGS |
950 |
c$$$ U(K) = DAL(K)/DOWN1 - VECTEMP(K)/DOWN2 |
951 |
c$$$ ENDDO |
952 |
DO I=1,5 |
953 |
DO J=1,5 |
954 |
CHI2DD(I,J) = COV(I,J)/2. |
955 |
$ +DAL(I)*DAL(J)/DOWN1 |
956 |
$ -VECTEMP(I)*VECTEMP(J)/DOWN2 |
957 |
c$$$ $ +DOWN2*U(I)*U(J) ! BFGS |
958 |
ENDDO |
959 |
ENDDO |
960 |
ENDIF |
961 |
|
962 |
RETURN |
963 |
END |
964 |
|
965 |
***************************************************************** |
966 |
* |
967 |
* Routine to compute the track intersection points |
968 |
* on the tracking-system planes, given the track parameters |
969 |
* |
970 |
* The routine is based on GRKUTA, which computes the |
971 |
* trajectory of a charged particle in a magnetic field |
972 |
* by solving the equatins of motion with Runge-Kuta method. |
973 |
* |
974 |
* Variables that have to be assigned when the subroutine |
975 |
* is called are: |
976 |
* |
977 |
* ZM(1,NEXTPLANES) ----> z coordinates of the planes |
978 |
* AL_P(1,5) ----> track-parameter vector |
979 |
* |
980 |
* ----------------------------------------------------------- |
981 |
* NB !!! |
982 |
* The routine works properly only if the |
983 |
* planes are numbered in descending order starting from the |
984 |
* reference plane (ZINI) |
985 |
* ----------------------------------------------------------- |
986 |
* |
987 |
***************************************************************** |
988 |
|
989 |
SUBROUTINE POSXYZEXT(AL_P,IFAIL) |
990 |
|
991 |
IMPLICIT DOUBLE PRECISION (A-H,O-Z) |
992 |
|
993 |
c include 'commontracker.f' !tracker general common |
994 |
include 'common_mini_ext.f' !common for the tracking procedure |
995 |
|
996 |
|
997 |
c LOGICAL TRKVERBOSE |
998 |
c COMMON/TRKD/TRKVERBOSE |
999 |
LOGICAL TRKDEBUG,TRKVERBOSE |
1000 |
COMMON/TRKD/TRKDEBUG,TRKVERBOSE |
1001 |
c |
1002 |
DIMENSION AL_P(5) |
1003 |
* |
1004 |
cpp DO I=1,nextplanes |
1005 |
cpp ZV(I)=ZM(I) ! |
1006 |
cpp ENDDO |
1007 |
* |
1008 |
* set parameters for GRKUTA |
1009 |
* |
1010 |
IF(AL_P(5).NE.0) CHARGE=AL_P(5)/DABS(AL_P(5)) |
1011 |
IF(AL_P(5).EQ.0) CHARGE=1. |
1012 |
VOUT(1)=AL_P(1) |
1013 |
VOUT(2)=AL_P(2) |
1014 |
VOUT(3)=ZINI ! DBLE(Z0)-DBLE(ZSPEC) |
1015 |
VOUT(4)=AL_P(3)*DCOS(AL_P(4)) |
1016 |
VOUT(5)=AL_P(3)*DSIN(AL_P(4)) |
1017 |
VOUT(6)=-1.*DSQRT(1.-AL_P(3)**2) |
1018 |
IF(AL_P(5).NE.0.) VOUT(7)=DABS(1./AL_P(5)) |
1019 |
IF(AL_P(5).EQ.0.) VOUT(7)=1.E8 |
1020 |
|
1021 |
c$$$ print*,'POSXY (prima) ',vout |
1022 |
|
1023 |
DO I=1,nextplanes |
1024 |
c$$$ ipass = 0 ! TEST |
1025 |
c$$$ PRINT *,'TRACKING -> START PLANE: ',I ! TEST |
1026 |
cPPP step=vout(3)-zm(i) |
1027 |
cPP step=(zm(i)-vout(3))/VOUT(6) |
1028 |
10 DO J=1,7 |
1029 |
VECT(J)=VOUT(J) |
1030 |
VECTINI(J)=VOUT(J) |
1031 |
ENDDO |
1032 |
cPPP step=vect(3)-zm(i) |
1033 |
IF(VOUT(6).GE.0.) THEN |
1034 |
IFAIL=1 |
1035 |
if(TRKVERBOSE) |
1036 |
$ PRINT *,'posxy (grkuta): WARNING ===> backward track!!' |
1037 |
RETURN |
1038 |
ENDIF |
1039 |
step=(zm(i)-vect(3))/VOUT(6) |
1040 |
11 continue |
1041 |
CALL GRKUTA(CHARGE,STEP,VECT,VOUT) |
1042 |
c$$$ ipass = ipass + 1 ! TEST |
1043 |
c$$$ PRINT *,'TRACKING -> STEP: ',ipass,' LENGHT: ', STEP ! TEST |
1044 |
IF(VOUT(3).GT.VECT(3)) THEN |
1045 |
IFAIL=1 |
1046 |
if(TRKVERBOSE) |
1047 |
$ PRINT *,'posxy (grkuta): WARNING ===> backward track!!' |
1048 |
c$$$ if(.TRUE.)print*,'charge',charge |
1049 |
c$$$ if(.TRUE.)print*,'vect',vect |
1050 |
c$$$ if(.TRUE.)print*,'vout',vout |
1051 |
c$$$ if(.TRUE.)print*,'step',step |
1052 |
if(TRKVERBOSE)print*,'charge',charge |
1053 |
if(TRKVERBOSE)print*,'vect',vect |
1054 |
if(TRKVERBOSE)print*,'vout',vout |
1055 |
if(TRKVERBOSE)print*,'step',step |
1056 |
RETURN |
1057 |
ENDIF |
1058 |
Z=VOUT(3) |
1059 |
IF(Z.LE.ZM(I)+TOLL.AND.Z.GE.ZM(I)-TOLL) GOTO 100 |
1060 |
IF(Z.GT.ZM(I)+TOLL) GOTO 10 |
1061 |
IF(Z.LE.ZM(I)-TOLL) THEN |
1062 |
STEP=STEP*(ZM(I)-VECT(3))/(Z-VECT(3)) |
1063 |
DO J=1,7 |
1064 |
VECT(J)=VECTINI(J) |
1065 |
ENDDO |
1066 |
GOTO 11 |
1067 |
ENDIF |
1068 |
|
1069 |
|
1070 |
* ----------------------------------------------- |
1071 |
* evaluate track coordinates |
1072 |
100 XV(I)=VOUT(1) |
1073 |
YV(I)=VOUT(2) |
1074 |
ZV(I)=VOUT(3) |
1075 |
AXV(I)=DATAN(VOUT(4)/VOUT(6))*180./ACOS(-1.) |
1076 |
AYV(I)=DATAN(VOUT(5)/VOUT(6))*180./ACOS(-1.) |
1077 |
* ----------------------------------------------- |
1078 |
|
1079 |
IF(TRACKMODE.EQ.1) THEN |
1080 |
* ----------------------------------------------- |
1081 |
* change of energy by bremsstrahlung for electrons |
1082 |
VOUT(7) = VOUT(7) * 0.997 !0.9968 |
1083 |
* ----------------------------------------------- |
1084 |
ENDIF |
1085 |
c$$$ PRINT *,'TRACKING -> END' ! TEST |
1086 |
|
1087 |
ENDDO |
1088 |
|
1089 |
c$$$ print*,'POSXY (dopo) ',vout |
1090 |
|
1091 |
|
1092 |
RETURN |
1093 |
END |
1094 |
|
1095 |
|
1096 |
|
1097 |
|
1098 |
c$$$ |
1099 |
c$$$* ********************************************************** |
1100 |
c$$$* Some initialization routines |
1101 |
c$$$* ********************************************************** |
1102 |
c$$$ |
1103 |
c$$$* ---------------------------------------------------------- |
1104 |
c$$$* Routine to initialize COMMON/TRACK/ |
1105 |
c$$$* |
1106 |
c$$$ subroutine track_init |
1107 |
c$$$ |
1108 |
c$$$ IMPLICIT DOUBLE PRECISION (A-H,O-Z) |
1109 |
c$$$ |
1110 |
c$$$c include 'commontracker.f' !tracker general common |
1111 |
c$$$ include 'common_mini_ext.f' !common for the tracking procedure |
1112 |
c$$$ include 'common_mech.f' |
1113 |
c$$$ |
1114 |
c$$$ do i=1,5 |
1115 |
c$$$ AL(i) = 0. |
1116 |
c$$$ enddo |
1117 |
c$$$ |
1118 |
c$$$ do ip=1,NEXTPLANES |
1119 |
c$$$ ZM(IP) = fitz(nextplanes-ip+1) !init to mech. position |
1120 |
c$$$ XM(IP) = -100. !0. |
1121 |
c$$$ YM(IP) = -100. !0. |
1122 |
c$$$ XM_A(IP) = -100. !0. |
1123 |
c$$$ YM_A(IP) = -100. !0. |
1124 |
c$$$ ZM_A(IP) = fitz(nextplanes-ip+1) !init to mech. position |
1125 |
c$$$ XM_B(IP) = -100. !0. |
1126 |
c$$$ YM_B(IP) = -100. !0. |
1127 |
c$$$ ZM_B(IP) = fitz(nextplanes-ip+1) !init to mech. position |
1128 |
c$$$ RESX(IP) = 1000. !3.d-4 |
1129 |
c$$$ RESY(IP) = 1000. !12.d-4 |
1130 |
c$$$ XGOOD(IP) = 0 |
1131 |
c$$$ YGOOD(IP) = 0 |
1132 |
c$$$ DEDXTRK_X(IP) = 0 |
1133 |
c$$$ DEDXTRK_Y(IP) = 0 |
1134 |
c$$$ AXV(IP) = 0 |
1135 |
c$$$ AYV(IP) = 0 |
1136 |
c$$$ XV(IP) = -100 |
1137 |
c$$$ YV(IP) = -100 |
1138 |
c$$$ enddo |
1139 |
c$$$ |
1140 |
c$$$ return |
1141 |
c$$$ end |
1142 |
c$$$ |
1143 |
c$$$ |
1144 |
*************************************************** |
1145 |
* * |
1146 |
* * |
1147 |
* * |
1148 |
* * |
1149 |
* * |
1150 |
* * |
1151 |
************************************************** |
1152 |
|
1153 |
subroutine guessext() |
1154 |
|
1155 |
c IMPLICIT DOUBLE PRECISION (A-H,O-Z) |
1156 |
|
1157 |
c include 'commontracker.f' !tracker general common |
1158 |
include 'common_mini_ext.f' !common for the tracking procedure |
1159 |
|
1160 |
REAL*4 XP(NEXTPLANES),ZP(NEXTPLANES),AP(NEXTPLANES),RP(NEXTPLANES) |
1161 |
REAL*4 CHI,XC,ZC,RADIUS |
1162 |
|
1163 |
c$$$ DO I=1,nextplanes |
1164 |
c$$$ print *,i,' - ',XGOOD(I),YGOOD(I) |
1165 |
c$$$ print *,i,' - ',xm(i),ym(i),zm(i) |
1166 |
c$$$ print *,i,' A ',xm_a(i),ym_a(i),zm_a(i) |
1167 |
c$$$ print *,i,' B ',xm_b(i),ym_b(i),zm_b(i) |
1168 |
c$$$ enddo |
1169 |
* ---------------------------------------- |
1170 |
* Y view |
1171 |
* ---------------------------------------- |
1172 |
* ---------------------------------------- |
1173 |
* initial guess with a straigth line |
1174 |
* ---------------------------------------- |
1175 |
SZZ=0. |
1176 |
SZY=0. |
1177 |
SSY=0. |
1178 |
SZ=0. |
1179 |
S1=0. |
1180 |
DO I=1,nextplanes |
1181 |
IF(YGOOD(I).EQ.1)THEN |
1182 |
YY = REAL(YM(I))!EM GCC4.7 |
1183 |
IF(XGOOD(I).EQ.0)THEN |
1184 |
YY = REAL((YM_A(I) + YM_B(I))/2.)!EM GCC4.7 |
1185 |
ENDIF |
1186 |
SZZ=SZZ+REAL(ZM(I)*ZM(I))!EM GCC4.7 |
1187 |
SZY=SZY+REAL(ZM(I)*YY)!EM GCC4.7 |
1188 |
SSY=SSY+YY |
1189 |
SZ=SZ+REAL(ZM(I))!EM GCC4.7 |
1190 |
S1=S1+1. |
1191 |
ENDIF |
1192 |
ENDDO |
1193 |
DET=SZZ*S1-SZ*SZ |
1194 |
AY=(SZY*S1-SZ*SSY)/DET |
1195 |
BY=(SZZ*SSY-SZY*SZ)/DET |
1196 |
Y0 = REAL(AY*ZINI+BY)!EM GCC4.7 |
1197 |
* ---------------------------------------- |
1198 |
* X view |
1199 |
* ---------------------------------------- |
1200 |
* ---------------------------------------- |
1201 |
* 1) initial guess with a circle |
1202 |
* ---------------------------------------- |
1203 |
NP=0 |
1204 |
DO I=1,nextplanes |
1205 |
IF(XGOOD(I).EQ.1)THEN |
1206 |
XX = REAL(XM(I))!EM GCC4.7 |
1207 |
IF(YGOOD(I).EQ.0)THEN |
1208 |
XX = REAL((XM_A(I) + XM_B(I))/2.)!EM GCC4.7 |
1209 |
ENDIF |
1210 |
NP=NP+1 |
1211 |
XP(NP)=XX |
1212 |
ZP(NP)=REAL(ZM(I))!EM GCC4.7 |
1213 |
ENDIF |
1214 |
ENDDO |
1215 |
IFLAG=0 !no debug mode |
1216 |
CALL TRICIRCLE(NP,XP,ZP,AP,RP,CHI,XC,ZC,RADIUS,IFLAG) |
1217 |
|
1218 |
c$$$ print*,' circle: ',XC,ZC,RADIUS,' --- ',CHI,IFLAG |
1219 |
c$$$ print*,' XP ',(xp(i),i=1,np) |
1220 |
c$$$ print*,' ZP ',(zp(i),i=1,np) |
1221 |
c$$$ print*,' AP ',(ap(i),i=1,np) |
1222 |
c$$$ print*,' XP ',(rp(i),i=1,np) |
1223 |
|
1224 |
IF(IFLAG.NE.0)GOTO 10 !straigth fit |
1225 |
c if(CHI.gt.100)GOTO 10 !straigth fit |
1226 |
ARG = REAL(RADIUS**2-(ZINI-ZC)**2)!EM GCC4.7 |
1227 |
IF(ARG.LT.0)GOTO 10 !straigth fit |
1228 |
DC = SQRT(ARG) |
1229 |
IF(XC.GT.0)DC=-DC |
1230 |
X0=XC+DC |
1231 |
AX = REAL(-(ZINI-ZC)/DC)!EM GCC4.7 |
1232 |
DEF=100./(RADIUS*0.3*0.43) |
1233 |
IF(XC.GT.0)DEF=-DEF |
1234 |
|
1235 |
|
1236 |
|
1237 |
IF(ABS(X0).GT.30)THEN |
1238 |
c$$$ PRINT*,'STRANGE GUESS: XC,ZC,R ',XC,ZC,RADIUS |
1239 |
c$$$ $ ,' - CHI ',CHI,' - X0,AX,DEF ',X0,AX,DEF |
1240 |
GOTO 10 !straigth fit |
1241 |
ENDIF |
1242 |
GOTO 20 !guess is ok |
1243 |
|
1244 |
* ---------------------------------------- |
1245 |
* 2) initial guess with a straigth line |
1246 |
* - if circle does not intersect reference plane |
1247 |
* - if bad chi**2 |
1248 |
* ---------------------------------------- |
1249 |
10 CONTINUE |
1250 |
SZZ=0. |
1251 |
SZX=0. |
1252 |
SSX=0. |
1253 |
SZ=0. |
1254 |
S1=0. |
1255 |
DO I=1,nextplanes |
1256 |
IF(XGOOD(I).EQ.1)THEN |
1257 |
XX = REAL(XM(I))!EM GCC4.7 |
1258 |
IF(YGOOD(I).EQ.0)THEN |
1259 |
XX = REAL((XM_A(I) + XM_B(I))/2.)!EM GCC4.7 |
1260 |
ENDIF |
1261 |
SZZ=SZZ+REAL(ZM(I)*ZM(I))!EM GCC4.7 |
1262 |
SZX=SZX+REAL(ZM(I)*XX)!EM GCC4.7 |
1263 |
SSX=SSX+XX |
1264 |
SZ=SZ+REAL(ZM(I))!EM GCC4.7 |
1265 |
S1=S1+1. |
1266 |
ENDIF |
1267 |
ENDDO |
1268 |
DET=SZZ*S1-SZ*SZ |
1269 |
AX=(SZX*S1-SZ*SSX)/DET |
1270 |
BX=(SZZ*SSX-SZX*SZ)/DET |
1271 |
DEF = 0 |
1272 |
X0 = REAL(AX*ZINI+BX)!EM GCC4.7 |
1273 |
|
1274 |
20 CONTINUE |
1275 |
* ---------------------------------------- |
1276 |
* guess |
1277 |
* ---------------------------------------- |
1278 |
|
1279 |
AL(1) = X0 |
1280 |
AL(2) = Y0 |
1281 |
tath = sqrt(AY**2+AX**2) |
1282 |
AL(3) = tath/sqrt(1+tath**2) |
1283 |
|
1284 |
AL(4)=0. |
1285 |
IF( AX.NE.0.OR.AY.NE.0. ) THEN |
1286 |
AL(4) = ASIN(AY/SQRT(AX**2+AY**2)) |
1287 |
IF(AX.LT.0.AND.AY.GE.0) AL(4) = ACOS(-1.0)-AL(4) |
1288 |
IF(AX.LT.0.AND.AY.LT.0) AL(4) = -ACOS(-1.0)-AL(4) |
1289 |
ENDIF |
1290 |
IF(AY.GT.0.) AL(4) = AL(4)-ACOS(-1.0) |
1291 |
IF(AY.LE.0.) AL(4) = AL(4)+ACOS(-1.0) |
1292 |
|
1293 |
AL(5) = DEF |
1294 |
|
1295 |
c print*,' guess: ',(al(i),i=1,5) |
1296 |
|
1297 |
end |