/[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.5 - (hide annotations) (download)
Wed Nov 8 16:42:28 2006 UTC (18 years, 1 month ago) by pam-fi
Branch: MAIN
Changes since 1.4: +5 -3 lines
fixed bug in readB

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

  ViewVC Help
Powered by ViewVC 1.1.23