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

Contents of /DarthVader/TrackerLevel2/src/F77/mini_ext.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations) (download)
Wed Jun 4 10:27:21 2014 UTC (10 years, 6 months ago) by pam-ts
Branch: MAIN
CVS Tags: v10REDr01, v10RED, HEAD
Error occurred while calculating annotation data.
Some missing routines added

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

  ViewVC Help
Powered by ViewVC 1.1.23