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

  ViewVC Help
Powered by ViewVC 1.1.23