/[PAMELA software]/DarthVader/TrackerLevel2/src/F77/mini.f
ViewVC logotype

Contents of /DarthVader/TrackerLevel2/src/F77/mini.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations) (download)
Tue Nov 7 15:55:11 2006 UTC (18 years, 1 month ago) by pam-fi
Branch: MAIN
Changes since 1.3: +249 -53 lines
track fit optimized and some bugs fixed

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

  ViewVC Help
Powered by ViewVC 1.1.23