/[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.16 - (hide annotations) (download)
Mon May 14 11:03:06 2007 UTC (17 years, 6 months ago) by pam-fi
Branch: MAIN
CVS Tags: v3r05, v3r06
Changes since 1.15: +1 -1 lines
implemented method to reprocess a track, starting from cluster positions

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

  ViewVC Help
Powered by ViewVC 1.1.23