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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.26 - (hide annotations) (download)
Thu Jan 16 15:29:56 2014 UTC (10 years, 10 months ago) by mocchiut
Branch: MAIN
Changes since 1.25: +4 -2 lines
Compilation warnings using GCC4.7 fixed

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

  ViewVC Help
Powered by ViewVC 1.1.23