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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.19 - (show annotations) (download)
Wed Jun 6 09:26:09 2007 UTC (17 years, 6 months ago) by pam-fi
Branch: MAIN
CVS Tags: v4r00
Changes since 1.18: +5 -1 lines
modified mini.f for student fit

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

  ViewVC Help
Powered by ViewVC 1.1.23