/[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.6 - (hide annotations) (download)
Tue Nov 14 16:21:09 2006 UTC (18 years ago) by pam-fi
Branch: MAIN
Changes since 1.5: +34 -10 lines
*** empty log message ***

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.4 DATA ISTEPMAX/120/ !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.6 DATA ALMAX/dinf,dinf,dinf,dinf,dinf/ !limits on alpha vector components
45     DATA ALMIN/-dinf,-dinf,-dinf,-dinf,-dinf/ !"
46 mocchiut 1.1
47     DIMENSION DAL(5) !increment of vector alfa
48 pam-fi 1.3 DIMENSION CHI2DD_R(4,4),CHI2D_R(4) !hessiano e gradiente di chi2
49 pam-fi 1.4
50     c elena--------
51     REAL*8 AVRESX,AVRESY
52     c elena--------
53    
54 mocchiut 1.1 INTEGER IFLAG
55     c--------------------------------------------------------
56     c IFLAG =1 ---- chi2 derivatives computed by using
57     c incremental ratios and posxyz.f
58     c IFLAG =2 ---- the approximation of Golden is used
59     c (see chisq.f)
60     c
61     c NB: the two metods gives equivalent results BUT
62     c method 2 is faster!!
63     c--------------------------------------------------------
64 pam-fi 1.3 DATA IFLAG/2/
65    
66 pam-fi 1.4 c LOGICAL TRKDEBUG,TRKVERBOSE
67     c COMMON/TRKD/TRKDEBUG,TRKVERBOSE
68     LOGICAL TRKDEBUG,TRKVERBOSE
69     COMMON/TRKD/TRKDEBUG,TRKVERBOSE
70 pam-fi 1.3
71     IF(IPRINT.EQ.1) THEN
72 pam-fi 1.4 TRKVERBOSE = .TRUE.
73     TRKDEBUG = .FALSE.
74     ELSEIF(IPRINT.EQ.2)THEN
75     TRKVERBOSE = .TRUE.
76     TRKDEBUG = .TRUE.
77 pam-fi 1.3 ELSE
78 pam-fi 1.4 TRKVERBOSE = .FALSE.
79     TRKDEBUG = .FALSE.
80 pam-fi 1.3 ENDIF
81 mocchiut 1.1
82     * ----------------------------------------------------------
83 pam-fi 1.4 * evaluate average spatial resolution
84     * ----------------------------------------------------------
85     AVRESX = RESXAV
86     AVRESY = RESYAV
87     DO IP=1,6
88     IF( XGOOD(IP).EQ.1 )THEN
89     NX=NX+1
90     AVRESX=AVRESX+RESX(IP)
91     ENDIF
92     IF(NX.NE.0)AVRESX=AVRESX/NX
93     IF( YGOOD(IP).EQ.1 )THEN
94     NY=NY+1
95     AVRESY=AVRESY+RESY(IP)
96     ENDIF
97     IF(NX.NE.0)AVRESY=AVRESY/NY
98     ENDDO
99    
100     * ----------------------------------------------------------
101 mocchiut 1.1 * define ALTOL(5) ---> tolerances on state vector
102     *
103     * ----------------------------------------------------------
104 pam-fi 1.4 * changed in order to evaluate energy-dependent
105     * tolerances on all 5 parameters
106     FACT=100. !scale factor to define tolerance on alfa
107 mocchiut 1.1 c deflection error (see PDG)
108 pam-fi 1.4 DELETA1 = 0.01/0.3/0.4/0.4451**2*SQRT(720./(6.+4.))
109     DELETA2 = 0.016/0.3/0.4/0.4451*SQRT(0.4451/9.36)
110     c$$$ ALTOL(1) = AVRESX/FACT !al(1) = x
111     c$$$ ALTOL(2) = AVRESY/FACT !al(2) = y
112     c$$$ ALTOL(3) = DSQRT(AVRESX**2 !al(3)=sin(theta)
113     c$$$ $ +AVRESY**2)/44.51/FACT
114     c$$$ ALTOL(4) = ALTOL(3) !al(4)=phi
115     c deflection error (see PDG)
116     c$$$ DELETA1 = 0.01*AVRESX/0.3/0.4/0.4451**2*SQRT(720./(6.+4.))
117     c$$$ DELETA2 = 0.016/0.3/0.4/0.4451*SQRT(0.4451/9.36)
118 mocchiut 1.1 * ----------------------------------------------------------
119     *
120     ISTEP=0 !num. steps to minimize chi^2
121     JFAIL=0 !error flag
122 pam-fi 1.4
123 pam-fi 1.5 if(TRKDEBUG) print*,'guess: ',al
124 pam-fi 1.4 if(TRKDEBUG) print*,'mini2: step ',istep,chi2,1./AL(5)
125    
126 pam-fi 1.3 *
127     * -----------------------
128     * START MINIMIZATION LOOP
129     * -----------------------
130     10 ISTEP=ISTEP+1 !<<<<<<<<<<<<<< NEW STEP !!
131    
132 mocchiut 1.1 CALL CHISQ(IFLAG,JFAIL) !chi^2 and its derivatives
133     IF(JFAIL.NE.0) THEN
134     IFAIL=1
135 pam-fi 1.3 CHI2=-9999.
136 pam-fi 1.4 if(TRKVERBOSE)
137 pam-fi 1.3 $ PRINT *,'*** ERROR in mini *** wrong CHISQ'
138 mocchiut 1.1 RETURN
139     ENDIF
140 pam-fi 1.3
141 pam-fi 1.6 COST=1e-9
142     costfac=1.1
143     flagstep=0
144    
145     7 continue
146    
147     IF(costfac.le.1.) THEN
148     IFAIL=1
149     PRINT *,'=== WARNING ===> no matrix inversion '
150     RETURN
151     ENDIF
152    
153 mocchiut 1.1 DO I=1,5
154     DO J=1,5
155     CHI2DD(I,J)=CHI2DD(I,J)*COST
156     ENDDO
157     CHI2D(I)=CHI2D(I)*COST
158     ENDDO
159 pam-fi 1.3
160     IF(PFIXED.EQ.0.) THEN
161    
162 mocchiut 1.1 *------------------------------------------------------------*
163     * track fitting with FREE deflection
164     *------------------------------------------------------------*
165 pam-fi 1.3 CALL DSFACT(5,CHI2DD,5,IFA,DET,JFA) !CHI2DD matrix determinant
166 pam-fi 1.6 IF(IFA.NE.0.or.jfa.ne.0) THEN !not positive-defined
167     if(ifa.eq.-1)then
168     if(TRKVERBOSE)then
169 pam-fi 1.3 PRINT *,
170     $ '*** ERROR in mini ***'//
171     $ 'on matrix inversion (not pos-def)'
172     $ ,DET
173 pam-fi 1.6 endif
174     IF(CHI2.EQ.0) CHI2=-9999.
175     IF(CHI2.GT.0) CHI2=-CHI2
176     IFAIL=1
177     RETURN
178     endif
179     if(jfa.eq.-1)then
180     if(flagstep.eq.-1.) costfac=(costfac-1)/2+1
181     cost=cost*costfact
182     flagstep=1.
183     goto 7
184     elseif(jfa.eq.1)then
185     if(flagstep.eq.1.) costfac=(costfac-1)/2+1
186     cost=cost/costfac
187     flagstep=-1.
188     goto 7
189     endif
190 pam-fi 1.3 ENDIF
191     CALL DSFINV(5,CHI2DD,5) !CHI2DD matrix inversion
192     * *******************************************
193     * find new value of AL-pha
194 pam-fi 1.4 * *******************************************
195 pam-fi 1.3 DO I=1,5
196     DAL(I)=0.
197     DO J=1,5
198     DAL(I)=DAL(I)-CHI2DD(I,J)*CHI2D(J)
199     COV(I,J)=2.*COST*CHI2DD(I,J)
200     ENDDO
201     ENDDO
202     DO I=1,5
203     AL(I)=AL(I)+DAL(I)
204     ENDDO
205     *------------------------------------------------------------*
206     * track fitting with FIXED deflection
207     *------------------------------------------------------------*
208     ELSE
209     AL(5)=1./PFIXED
210     DO I=1,4
211     CHI2D_R(I)=CHI2D(I)
212     DO J=1,4
213     CHI2DD_R(I,J)=CHI2DD(I,J)
214     ENDDO
215     ENDDO
216     CALL DSFACT(4,CHI2DD_R,4,IFA,DET,JFA)
217     IF(IFA.NE.0) THEN
218 pam-fi 1.4 if(TRKVERBOSE)then
219 pam-fi 1.3 PRINT *,
220     $ '*** ERROR in mini ***'//
221     $ 'on matrix inversion (not pos-def)'
222     $ ,DET
223     endif
224     IF(CHI2.EQ.0) CHI2=-9999.
225     IF(CHI2.GT.0) CHI2=-CHI2
226     IFAIL=1
227     RETURN
228     ENDIF
229     CALL DSFINV(4,CHI2DD_R,4)
230 pam-fi 1.4 * *******************************************
231     * find new value of AL-pha
232     * *******************************************
233 pam-fi 1.3 DO I=1,4
234     DAL(I)=0.
235     DO J=1,4
236     DAL(I)=DAL(I)-CHI2DD_R(I,J)*CHI2D_R(J)
237     COV(I,J)=2.*COST*CHI2DD_R(I,J)
238     ENDDO
239     ENDDO
240     DAL(5)=0.
241     DO I=1,4
242     AL(I)=AL(I)+DAL(I)
243     ENDDO
244 mocchiut 1.1 ENDIF
245 pam-fi 1.4
246     if(TRKDEBUG) print*,'mini2: step ',istep,chi2,1./AL(5)
247    
248 pam-fi 1.3 *------------------------------------------------------------*
249     * ---------------------------------------------------- *
250     *------------------------------------------------------------*
251 mocchiut 1.1 * check parameter bounds:
252 pam-fi 1.4 *------------------------------------------------------------*
253 mocchiut 1.1 DO I=1,5
254     IF(AL(I).GT.ALMAX(I).OR.AL(I).LT.ALMIN(I))THEN
255 pam-fi 1.4 if(TRKVERBOSE)then
256 pam-fi 1.3 PRINT*,' *** WARNING in mini *** '
257 mocchiut 1.1 PRINT*,'MINI_2 ==> AL(',I,') out of range'
258     PRINT*,' value: ',AL(I),
259     $ ' limits: ',ALMIN(I),ALMAX(I)
260     print*,'istep ',istep
261     endif
262 pam-fi 1.3 IF(CHI2.EQ.0) CHI2=-9999.
263     IF(CHI2.GT.0) CHI2=-CHI2
264 mocchiut 1.1 IFAIL=1
265     RETURN
266     ENDIF
267     ENDDO
268 pam-fi 1.4 *------------------------------------------------------------*
269 mocchiut 1.1 * check number of steps:
270 pam-fi 1.4 *------------------------------------------------------------*
271     IF(ISTEP.ge.ISTEPMAX) then
272 mocchiut 1.1 IFAIL=1
273 pam-fi 1.4 if(TRKVERBOSE)
274 pam-fi 1.3 $ PRINT *,'*** WARNING in mini *** ISTEP.GT.ISTEPMAX=',
275     $ ISTEPMAX
276 mocchiut 1.1 goto 11
277     endif
278 pam-fi 1.4 *------------------------------------------------------------*
279 mocchiut 1.1 * ---------------------------------------------
280     * evaluate deflection tolerance on the basis of
281     * estimated deflection
282     * ---------------------------------------------
283 pam-fi 1.4 *------------------------------------------------------------*
284     c$$$ ALTOL(5) = DSQRT(DELETA1**2+DELETA2**2*AL(5)**2)/FACT
285     ALTOL(5) = DSQRT((DELETA1*AVRESX)**2+DELETA2**2*AL(5)**2)/FACT
286     ALTOL(1) = ALTOL(5)/DELETA1
287     ALTOL(2) = ALTOL(1)
288     ALTOL(3) = DSQRT(ALTOL(1)**2+ALTOL(2)**2)/44.51
289     ALTOL(4) = ALTOL(3)
290    
291 mocchiut 1.1 *---- check tolerances:
292 pam-fi 1.4 c$$$ DO I=1,5
293     c$$$ if(TRKVERBOSE)print*,i,' -- ',DAL(I),ALTOL(I) !>>>> new step!
294     c$$$ ENDDO
295     c$$$ print*,'chi2 -- ',DCHI2
296    
297 mocchiut 1.1 DO I=1,5
298     IF(ABS(DAL(I)).GT.ALTOL(I))GOTO 10 !>>>> new step!
299     ENDDO
300    
301 pam-fi 1.3 * new estimate of chi^2:
302     JFAIL=0 !error flag
303     CALL CHISQ(IFLAG,JFAIL) !chi^2 and its derivatives
304     IF(JFAIL.NE.0) THEN
305     IFAIL=1
306 pam-fi 1.4 if(TRKVERBOSE)THEN
307 pam-fi 1.3 CHI2=-9999.
308 pam-fi 1.4 if(TRKVERBOSE)
309 pam-fi 1.3 $ PRINT *,'*** ERROR in mini *** wrong CHISQ'
310     ENDIF
311     RETURN
312     ENDIF
313     COST=1e-7
314     DO I=1,5
315     DO J=1,5
316     CHI2DD(I,J)=CHI2DD(I,J)*COST
317     ENDDO
318     CHI2D(I)=CHI2D(I)*COST
319     ENDDO
320     IF(PFIXED.EQ.0.) THEN
321     CALL DSFACT(5,CHI2DD,5,IFA,DET,JFA) !CHI2DD matrix determinant
322     IF(IFA.NE.0) THEN !not positive-defined
323 pam-fi 1.4 if(TRKVERBOSE)then
324 pam-fi 1.3 PRINT *,
325     $ '*** ERROR in mini ***'//
326     $ 'on matrix inversion (not pos-def)'
327     $ ,DET
328     endif
329     IF(CHI2.EQ.0) CHI2=-9999.
330     IF(CHI2.GT.0) CHI2=-CHI2
331     IFAIL=1
332     RETURN
333     ENDIF
334     CALL DSFINV(5,CHI2DD,5) !CHI2DD matrix inversion
335     DO I=1,5
336     DAL(I)=0.
337     DO J=1,5
338     COV(I,J)=2.*COST*CHI2DD(I,J)
339     ENDDO
340     ENDDO
341     ELSE
342     DO I=1,4
343     CHI2D_R(I)=CHI2D(I)
344     DO J=1,4
345     CHI2DD_R(I,J)=CHI2DD(I,J)
346     ENDDO
347     ENDDO
348     CALL DSFACT(4,CHI2DD_R,4,IFA,DET,JFA)
349     IF(IFA.NE.0) THEN
350 pam-fi 1.4 if(TRKVERBOSE)then
351 pam-fi 1.3 PRINT *,
352     $ '*** ERROR in mini ***'//
353     $ 'on matrix inversion (not pos-def)'
354     $ ,DET
355     endif
356     IF(CHI2.EQ.0) CHI2=-9999.
357     IF(CHI2.GT.0) CHI2=-CHI2
358     IFAIL=1
359     RETURN
360     ENDIF
361     CALL DSFINV(4,CHI2DD_R,4)
362     DO I=1,4
363     DAL(I)=0.
364     DO J=1,4
365     COV(I,J)=2.*COST*CHI2DD_R(I,J)
366     ENDDO
367     ENDDO
368     ENDIF
369     *****************************
370 mocchiut 1.1
371     * ------------------------------------
372     * Number of Degree Of Freedom
373     ndof=0
374     do ip=1,nplanes
375     ndof=ndof
376     $ +int(xgood(ip))
377     $ +int(ygood(ip))
378     enddo
379 pam-fi 1.3 if(pfixed.eq.0.) ndof=ndof-5 ! ***PP***
380     if(pfixed.ne.0.) ndof=ndof-4 ! ***PP***
381     if(ndof.le.0.) then
382     ndof = 1
383 pam-fi 1.4 if(TRKVERBOSE)
384 pam-fi 1.3 $ print*,'*** WARNING *** in mini n.dof = 0 (set to 1)'
385     endif
386 pam-fi 1.4
387     if(TRKDEBUG) print*,'mini2: -ok- ',istep,chi2,1./AL(5)
388    
389 mocchiut 1.1 * ------------------------------------
390     * Reduced chi^2
391     CHI2 = CHI2/dble(ndof)
392    
393 pam-fi 1.4 c print*,'mini2: chi2 ',chi2
394    
395 mocchiut 1.1 11 CONTINUE
396    
397 pam-fi 1.3 NSTEP=ISTEP ! ***PP***
398 mocchiut 1.1
399     RETURN
400     END
401    
402     ******************************************************************************
403     *
404     * routine to compute chi^2 and its derivatives
405     *
406     *
407     * (modified in respect to the previous one in order to include
408     * single clusters. In this case the residual is evaluated by
409     * calculating the distance between the track intersection and the
410     * segment AB associated to the single cluster)
411     *
412     ******************************************************************************
413    
414     SUBROUTINE CHISQ(IFLAG,IFAIL)
415    
416     IMPLICIT DOUBLE PRECISION (A-H,O-Z)
417    
418     include 'commontracker.f' !tracker general common
419     include 'common_mini_2.f' !common for the tracking procedure
420    
421     DIMENSION XV2(nplanes),YV2(nplanes),XV1(nplanes),YV1(nplanes)
422     $ ,XV0(nplanes),YV0(nplanes)
423     DIMENSION AL_P(5)
424 pam-fi 1.3
425 pam-fi 1.4 c LOGICAL TRKVERBOSE
426     c COMMON/TRKD/TRKVERBOSE
427     LOGICAL TRKDEBUG,TRKVERBOSE
428     COMMON/TRKD/TRKDEBUG,TRKVERBOSE
429 mocchiut 1.1 *
430     * chi^2 computation
431     *
432     DO I=1,5
433     AL_P(I)=AL(I)
434     ENDDO
435     JFAIL=0 !error flag
436     CALL POSXYZ(AL_P,JFAIL) !track intersection with tracking planes
437     IF(JFAIL.NE.0) THEN
438 pam-fi 1.4 IF(TRKVERBOSE)
439 pam-fi 1.3 $ PRINT *,'CHISQ ==> error from trk routine POSXYZ !!'
440 mocchiut 1.1 IFAIL=1
441     RETURN
442     ENDIF
443     DO I=1,nplanes
444     XV0(I)=XV(I)
445     YV0(I)=YV(I)
446     ENDDO
447     * ------------------------------------------------
448     c$$$ CHI2=0.
449     c$$$ DO I=1,nplanes
450     c$$$ CHI2=CHI2
451     c$$$ + +(XV(I)-XM(I))**2/RESX(i)**2 *XGOOD(I)*YGOOD(I)
452     c$$$ + +(YV(I)-YM(I))**2/RESY(i)**2 *YGOOD(I)*XGOOD(I)
453     c$$$ ENDDO
454     * ---------------------------------------------------------
455     * For planes with only a X or Y-cl included, instead of
456     * a X-Y couple, the residual for chi^2 calculation is
457     * evaluated by finding the point x-y, along the segment AB,
458     * closest to the track.
459     * The X or Y coordinate, respectivelly for X and Y-cl, is
460     * then assigned to XM or YM, which is then considered the
461     * measured position of the cluster.
462     * ---------------------------------------------------------
463     CHI2=0.
464     DO I=1,nplanes
465     IF(XGOOD(I).EQ.1.AND.YGOOD(I).EQ.0)THEN !X-cl
466     BETA = (XM_B(I)-XM_A(I))/(YM_B(I)-YM_A(I))
467     ALFA = XM_A(I) - BETA * YM_A(I)
468     YM(I) = ( YV(I) + BETA*XV(I) - BETA*ALFA )/(1+BETA**2)
469     if(YM(I).lt.dmin1(YM_A(I),YM_B(I)))
470     $ YM(I)=dmin1(YM_A(I),YM_B(I))
471     if(YM(I).gt.dmax1(YM_A(I),YM_B(I)))
472     $ YM(I)=dmax1(YM_A(I),YM_B(I))
473     XM(I) = ALFA + BETA * YM(I) !<<<< measured coordinates
474     ELSEIF(XGOOD(I).EQ.0.AND.YGOOD(I).EQ.1)THEN !Y-cl
475     BETA = (YM_B(I)-YM_A(I))/(XM_B(I)-XM_A(I))
476     ALFA = YM_A(I) - BETA * XM_A(I)
477     XM(I) = ( XV(I) + BETA*YV(I) - BETA*ALFA )/(1+BETA**2)
478     if(XM(I).lt.dmin1(XM_A(I),XM_B(I)))
479     $ XM(I)=dmin1(XM_A(I),XM_B(I))
480     if(XM(I).gt.dmax1(XM_A(I),XM_B(I)))
481     $ XM(I)=dmax1(XM_A(I),XM_B(I))
482     YM(I) = ALFA + BETA * XM(I) !<<<< measured coordinates
483     ENDIF
484     CHI2=CHI2
485     + +(XV(I)-XM(I))**2/RESX(i)**2 *( XGOOD(I)*YGOOD(I) )
486     + +(YV(I)-YM(I))**2/RESY(i)**2 *( YGOOD(I)*XGOOD(I) )
487     + +((XV(I)-XM(I))**2+(YV(I)-YM(I))**2)/RESX(i)**2
488     + *( XGOOD(I)*(1-YGOOD(I)) )
489     + +((XV(I)-XM(I))**2+(YV(I)-YM(I))**2)/RESY(i)**2
490     + *( (1-XGOOD(I))*YGOOD(I) )
491     ENDDO
492 pam-fi 1.5 c print*,'CHISQ ',chi2
493 mocchiut 1.1 * ------------------------------------------------
494     *
495     * calculation of derivatives (dX/dAL_fa and dY/dAL_fa)
496     *
497     * //////////////////////////////////////////////////
498     * METHOD 1 -- incremental ratios
499     * //////////////////////////////////////////////////
500    
501     IF(IFLAG.EQ.1) THEN
502    
503     DO J=1,5
504     DO JJ=1,5
505     AL_P(JJ)=AL(JJ)
506     ENDDO
507     AL_P(J)=AL_P(J)+STEPAL(J)/2.
508     JFAIL=0
509     CALL POSXYZ(AL_P,JFAIL)
510     IF(JFAIL.NE.0) THEN
511 pam-fi 1.4 IF(TRKVERBOSE)
512 pam-fi 1.3 *23456789012345678901234567890123456789012345678901234567890123456789012
513     $ PRINT *,'CHISQ ==> error from trk routine POSXYZ'
514 mocchiut 1.1 IFAIL=1
515     RETURN
516     ENDIF
517     DO I=1,nplanes
518     XV2(I)=XV(I)
519     YV2(I)=YV(I)
520     ENDDO
521     AL_P(J)=AL_P(J)-STEPAL(J)
522     JFAIL=0
523     CALL POSXYZ(AL_P,JFAIL)
524     IF(JFAIL.NE.0) THEN
525 pam-fi 1.4 IF(TRKVERBOSE)
526 pam-fi 1.3 $ PRINT *,'CHISQ ==> error from trk routine POSXYZ'
527 mocchiut 1.1 IFAIL=1
528     RETURN
529     ENDIF
530     DO I=1,nplanes
531     XV1(I)=XV(I)
532     YV1(I)=YV(I)
533     ENDDO
534     DO I=1,nplanes
535     DXDAL(I,J)=(XV2(I)-XV1(I))/STEPAL(J)
536     DYDAL(I,J)=(YV2(I)-YV1(I))/STEPAL(J)
537     ENDDO
538     ENDDO
539    
540     ENDIF
541    
542     * //////////////////////////////////////////////////
543     * METHOD 2 -- Bob Golden
544     * //////////////////////////////////////////////////
545    
546     IF(IFLAG.EQ.2) THEN
547    
548     DO I=1,nplanes
549     DXDAL(I,1)=1.
550     DYDAL(I,1)=0.
551    
552     DXDAL(I,2)=0.
553     DYDAL(I,2)=1.
554    
555     COSTHE=DSQRT(1.-AL(3)**2)
556     IF(COSTHE.EQ.0.) THEN
557 pam-fi 1.4 IF(TRKVERBOSE)PRINT *,'=== WARNING ===> COSTHE=0'
558 pam-fi 1.3 IFAIL=1
559     RETURN
560 mocchiut 1.1 ENDIF
561    
562     DXDAL(I,3)=(ZINI-ZM(I))*DCOS(AL(4))/COSTHE**3
563     DYDAL(I,3)=(ZINI-ZM(I))*DSIN(AL(4))/COSTHE**3
564    
565     DXDAL(I,4)=-AL(3)*(ZINI-ZM(I))*DSIN(AL(4))/COSTHE
566     DYDAL(I,4)=AL(3)*(ZINI-ZM(I))*DCOS(AL(4))/COSTHE
567    
568     IF(AL(5).NE.0.) THEN
569     DXDAL(I,5)=
570     + (XV(I)-(AL(1)+AL(3)/COSTHE*(ZINI-ZM(I))
571     + *DCOS(AL(4))))/AL(5)
572     DYDAL(I,5)=
573     + (YV(I)-(AL(2)+AL(3)/COSTHE*(ZINI-ZM(I))
574     + *DSIN(AL(4))))/AL(5)
575     ELSE
576     DXDAL(I,5)=100.*( 0.25 *0.3*0.4*(0.01*(ZINI-ZM(I)))**2 )
577     DYDAL(I,5)=0.
578     ENDIF
579    
580     ENDDO
581     ENDIF
582     *
583     * 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
584     * >>> CHI2D evaluation
585     *
586     DO J=1,5
587     CHI2D(J)=0.
588     DO I=1,nplanes
589     CHI2D(J)=CHI2D(J)
590     + +2.*(XV0(I)-XM(I))/RESX(i)**2*DXDAL(I,J) *XGOOD(I)
591     + +2.*(YV0(I)-YM(I))/RESY(i)**2*DYDAL(I,J) *YGOOD(I)
592     ENDDO
593     ENDDO
594     *
595     * >>> CHI2DD evaluation
596     *
597     DO I=1,5
598     DO J=1,5
599     CHI2DD(I,J)=0.
600     DO K=1,nplanes
601     CHI2DD(I,J)=CHI2DD(I,J)
602     + +2.*DXDAL(K,I)*DXDAL(K,J)/RESX(k)**2 *XGOOD(K)
603     + +2.*DYDAL(K,I)*DYDAL(K,J)/RESY(k)**2 *YGOOD(K)
604     ENDDO
605     ENDDO
606     ENDDO
607     * 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
608    
609     RETURN
610     END
611    
612    
613     *****************************************************************
614     *
615     * Routine to compute the track intersection points
616     * on the tracking-system planes, given the track parameters
617     *
618     * The routine is based on GRKUTA, which computes the
619     * trajectory of a charged particle in a magnetic field
620     * by solving the equatins of motion with Runge-Kuta method.
621     *
622     * Variables that have to be assigned when the subroutine
623     * is called are:
624     *
625     * ZM(1,NPLANES) ----> z coordinates of the planes
626     * AL_P(1,5) ----> track-parameter vector
627     *
628     * -----------------------------------------------------------
629     * NB !!!
630     * The routine works properly only if the
631     * planes are numbered in descending order starting from the
632     * reference plane (ZINI)
633     * -----------------------------------------------------------
634     *
635     *****************************************************************
636    
637     SUBROUTINE POSXYZ(AL_P,IFAIL)
638    
639     IMPLICIT DOUBLE PRECISION (A-H,O-Z)
640    
641     include 'commontracker.f' !tracker general common
642     include 'common_mini_2.f' !common for the tracking procedure
643 pam-fi 1.3
644 pam-fi 1.4 c LOGICAL TRKVERBOSE
645     c COMMON/TRKD/TRKVERBOSE
646     LOGICAL TRKDEBUG,TRKVERBOSE
647     COMMON/TRKD/TRKDEBUG,TRKVERBOSE
648 mocchiut 1.1 c
649     DIMENSION AL_P(5)
650     *
651     DO I=1,nplanes
652     ZV(I)=ZM(I) !
653     ENDDO
654     *
655     * set parameters for GRKUTA
656     *
657     IF(AL_P(5).NE.0) CHARGE=AL_P(5)/DABS(AL_P(5))
658     IF(AL_P(5).EQ.0) CHARGE=1.
659     VOUT(1)=AL_P(1)
660     VOUT(2)=AL_P(2)
661     VOUT(3)=ZINI ! DBLE(Z0)-DBLE(ZSPEC)
662     VOUT(4)=AL_P(3)*DCOS(AL_P(4))
663     VOUT(5)=AL_P(3)*DSIN(AL_P(4))
664     VOUT(6)=-1.*DSQRT(1.-AL_P(3)**2)
665     IF(AL_P(5).NE.0.) VOUT(7)=DABS(1./AL_P(5))
666     IF(AL_P(5).EQ.0.) VOUT(7)=1.E8
667 pam-fi 1.5
668     c$$$ print*,'POSXY ',vout
669    
670 mocchiut 1.1 DO I=1,nplanes
671     step=vout(3)-zv(i)
672     10 DO J=1,7
673     VECT(J)=VOUT(J)
674     VECTINI(J)=VOUT(J)
675     ENDDO
676     11 continue
677     CALL GRKUTA(CHARGE,STEP,VECT,VOUT)
678     IF(VOUT(3).GT.VECT(3)) THEN
679     IFAIL=1
680 pam-fi 1.4 if(TRKVERBOSE)
681 pam-fi 1.2 $ PRINT *,'posxy (grkuta): WARNING ===> backward track!!'
682 pam-fi 1.4 c$$$ if(.TRUE.)print*,'charge',charge
683     c$$$ if(.TRUE.)print*,'vect',vect
684     c$$$ if(.TRUE.)print*,'vout',vout
685     c$$$ if(.TRUE.)print*,'step',step
686     if(TRKVERBOSE)print*,'charge',charge
687     if(TRKVERBOSE)print*,'vect',vect
688     if(TRKVERBOSE)print*,'vout',vout
689     if(TRKVERBOSE)print*,'step',step
690 mocchiut 1.1 RETURN
691     ENDIF
692     Z=VOUT(3)
693     IF(Z.LE.ZM(I)+TOLL.AND.Z.GE.ZM(I)-TOLL) GOTO 100
694     IF(Z.GT.ZM(I)+TOLL) GOTO 10
695     IF(Z.LE.ZM(I)-TOLL) THEN
696     STEP=STEP*(ZM(I)-VECT(3))/(Z-VECT(3))
697     DO J=1,7
698     VECT(J)=VECTINI(J)
699     ENDDO
700     GOTO 11
701     ENDIF
702    
703     * -----------------------------------------------
704     * evaluate track coordinates
705     100 XV(I)=VOUT(1)
706     YV(I)=VOUT(2)
707     ZV(I)=VOUT(3)
708     AXV(I)=DATAN(VOUT(4)/VOUT(6))*180./ACOS(-1.)
709     AYV(I)=DATAN(VOUT(5)/VOUT(6))*180./ACOS(-1.)
710     * -----------------------------------------------
711    
712     ENDDO
713    
714     RETURN
715     END
716    
717    
718    
719    
720    
721     * **********************************************************
722     * Some initialization routines
723     * **********************************************************
724    
725     * ----------------------------------------------------------
726     * Routine to initialize COMMON/TRACK/
727     *
728     subroutine track_init
729    
730     IMPLICIT DOUBLE PRECISION (A-H,O-Z)
731    
732     include 'commontracker.f' !tracker general common
733     include 'common_mini_2.f' !common for the tracking procedure
734     include 'common_mech.f'
735    
736     do i=1,5
737     AL(i) = 0.
738     enddo
739    
740     do ip=1,NPLANES
741     ZM(IP) = fitz(nplanes-ip+1) !init to mech. position
742     XM(IP) = -100. !0.
743     YM(IP) = -100. !0.
744     XM_A(IP) = -100. !0.
745     YM_A(IP) = -100. !0.
746     c ZM_A(IP) = 0
747     XM_B(IP) = -100. !0.
748     YM_B(IP) = -100. !0.
749     c ZM_B(IP) = 0
750     RESX(IP) = 1000. !3.d-4
751     RESY(IP) = 1000. !12.d-4
752     XGOOD(IP) = 0
753     YGOOD(IP) = 0
754     enddo
755    
756     return
757     end
758 pam-fi 1.4
759    
760     ***************************************************
761     * *
762     * *
763     * *
764     * *
765     * *
766     * *
767     **************************************************
768    
769     subroutine guess()
770    
771     c IMPLICIT DOUBLE PRECISION (A-H,O-Z)
772    
773     include 'commontracker.f' !tracker general common
774     include 'common_mini_2.f' !common for the tracking procedure
775    
776     REAL*4 XP(NPLANES),ZP(NPLANES),AP(NPLANES),RP(NPLANES)
777     REAL*4 CHI,XC,ZC,RADIUS
778     * ----------------------------------------
779     * Y view
780     * ----------------------------------------
781     * ----------------------------------------
782     * initial guess with a straigth line
783     * ----------------------------------------
784     SZZ=0.
785     SZY=0.
786     SSY=0.
787     SZ=0.
788     S1=0.
789     DO I=1,nplanes
790     IF(YGOOD(I).EQ.1)THEN
791     YY = YM(I)
792     IF(XGOOD(I).EQ.0)THEN
793     YY = (YM_A(I) + YM_B(I))/2
794     ENDIF
795     SZZ=SZZ+ZM(I)*ZM(I)
796     SZY=SZY+ZM(I)*YY
797     SSY=SSY+YY
798     SZ=SZ+ZM(I)
799     S1=S1+1.
800     ENDIF
801     ENDDO
802     DET=SZZ*S1-SZ*SZ
803     AY=(SZY*S1-SZ*SSY)/DET
804     BY=(SZZ*SSY-SZY*SZ)/DET
805     Y0 = AY*ZINI+BY
806     * ----------------------------------------
807     * X view
808     * ----------------------------------------
809     * ----------------------------------------
810     * 1) initial guess with a circle
811     * ----------------------------------------
812     NP=0
813     DO I=1,nplanes
814     IF(XGOOD(I).EQ.1)THEN
815     XX = XM(I)
816     IF(YGOOD(I).EQ.0)THEN
817     XX = (XM_A(I) + XM_B(I))/2
818     ENDIF
819     NP=NP+1
820     XP(NP)=XX
821     ZP(NP)=ZM(I)
822     ENDIF
823     ENDDO
824     CALL TRICIRCLE(NP,XP,ZP,AP,RP,CHI,XC,ZC,RADIUS,IFLAG)
825     c print*,' circle: ',XC,ZC,RADIUS,' --- ',CHI
826     IF(IFLAG.NE.0)GOTO 10 !straigth fit
827     ARG = RADIUS**2-(ZINI-ZC)**2
828     IF(ARG.LT.0)GOTO 10 !straigth fit
829     DC = SQRT(ARG)
830     IF(XC.GT.0)DC=-DC
831     X0=XC+DC
832     AX = -(ZINI-ZC)/DC
833     DEF=100./(RADIUS*0.3*0.43)
834     IF(XC.GT.0)DEF=-DEF
835     GOTO 20 !guess is ok
836    
837     * ----------------------------------------
838     * 2) initial guess with a straigth line
839     * - if circle does not intersect reference plane
840     * - if bad chi**2
841     * ----------------------------------------
842     10 CONTINUE
843     SZZ=0.
844     SZX=0.
845     SSX=0.
846     SZ=0.
847     S1=0.
848     DO I=1,nplanes
849     IF(XGOOD(I).EQ.1)THEN
850     XX = XM(I)
851     IF(YGOOD(I).EQ.0)THEN
852     XX = (XM_A(I) + XM_B(I))/2
853     ENDIF
854     SZZ=SZZ+ZM(I)*ZM(I)
855     SZX=SZX+ZM(I)*XX
856     SSX=SSX+XX
857     SZ=SZ+ZM(I)
858     S1=S1+1.
859     ENDIF
860     ENDDO
861     DET=SZZ*S1-SZ*SZ
862     AX=(SZX*S1-SZ*SSX)/DET
863     BX=(SZZ*SSX-SZX*SZ)/DET
864     DEF = 0
865     X0 = AX*ZINI+BX
866    
867     20 CONTINUE
868     * ----------------------------------------
869     * guess
870     * ----------------------------------------
871    
872     AL(1) = X0
873     AL(2) = Y0
874     tath = sqrt(AY**2+AX**2)
875     AL(3) = tath/sqrt(1+tath**2)
876     IF(AX.NE.0)THEN
877     AL(4)= atan(AY/AX)
878     ELSE
879     AL(4) = acos(-1.)/2
880     IF(AY.LT.0)AL(4) = AL(4)+acos(-1.)
881     ENDIF
882     IF(AX.LT.0)AL(4)= acos(-1.)+ AL(4)
883     AL(4) = -acos(-1.) + AL(4) !from incidence direction to tracking rs
884     AL(5) = DEF
885    
886     c print*,' guess: ',(al(i),i=1,5)
887    
888     end

  ViewVC Help
Powered by ViewVC 1.1.23