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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide 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
Some missing routines added

1 pam-ts 1.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