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

  ViewVC Help
Powered by ViewVC 1.1.23