/[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.22 - (hide annotations) (download)
Thu Nov 20 15:06:27 2008 UTC (16 years ago) by bongi
Branch: MAIN
Changes since 1.21: +180 -51 lines
change in the fit method fot singlets

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

  ViewVC Help
Powered by ViewVC 1.1.23