/[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.11 - (show 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 ************************************************************************
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/100/ !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 c DATA ALMAX/dinf,dinf,1.,dinf,dinf/ !limits on alpha vector components
45 c DATA ALMIN/-dinf,-dinf,-1.,-dinf,-dinf/ !"
46 DATA ALMAX/dinf,dinf,1.,dinf,dinf/ !limits on alpha vector components
47 DATA ALMIN/-dinf,-dinf,-1.,-dinf,-dinf/ !"
48
49 DIMENSION DAL(5) !increment of vector alfa
50 DIMENSION CHI2DD_R(4,4),CHI2D_R(4) !hessiano e gradiente di chi2
51
52 c elena--------
53 REAL*8 AVRESX,AVRESY
54 c elena--------
55
56 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 DATA IFLAG/2/
67
68 c LOGICAL TRKDEBUG,TRKVERBOSE
69 c COMMON/TRKD/TRKDEBUG,TRKVERBOSE
70 LOGICAL TRKDEBUG,TRKVERBOSE
71 COMMON/TRKD/TRKDEBUG,TRKVERBOSE
72
73 IF(IPRINT.EQ.1) THEN
74 TRKVERBOSE = .TRUE.
75 TRKDEBUG = .FALSE.
76 ELSEIF(IPRINT.EQ.2)THEN
77 TRKVERBOSE = .TRUE.
78 TRKDEBUG = .TRUE.
79 ELSE
80 TRKVERBOSE = .FALSE.
81 TRKDEBUG = .FALSE.
82 ENDIF
83
84 * ----------------------------------------------------------
85 * 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 * define ALTOL(5) ---> tolerances on state vector
104 *
105 * ----------------------------------------------------------
106 * changed in order to evaluate energy-dependent
107 * tolerances on all 5 parameters
108 FACT=100. !scale factor to define tolerance on alfa
109 c deflection error (see PDG)
110 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 * ----------------------------------------------------------
121 *
122 ISTEP=0 !num. steps to minimize chi^2
123 JFAIL=0 !error flag
124
125 if(TRKDEBUG) print*,'guess: ',al
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-5
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 c$$$ IFAIL=1
251 c$$$ if(TRKVERBOSE)
252 c$$$ $ PRINT *,'*** WARNING in mini *** ISTEP.GT.ISTEPMAX=',
253 c$$$ $ 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 IF(ISTEP.LT.3) GOTO 10 ! ***PP***
276 DO I=1,5
277 IF(ABS(DAL(I)).GT.ALTOL(I))GOTO 10 !>>>> new step!
278 ENDDO
279
280 * 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 if(TRKVERBOSE)THEN
286 CHI2=-9999.
287 if(TRKVERBOSE)
288 $ 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 if(TRKVERBOSE)then
303 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 if(TRKVERBOSE)then
330 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
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 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 if(TRKVERBOSE)
363 $ print*,'*** WARNING *** in mini n.dof = 0 (set to 1)'
364 endif
365
366 if(TRKDEBUG) print*,'mini2: -ok- ',istep,chi2,1./AL(5)
367
368 * ------------------------------------
369 * Reduced chi^2
370 CHI2 = CHI2/dble(ndof)
371
372 c print*,'mini2: chi2 ',chi2
373
374 11 CONTINUE
375
376 NSTEP=ISTEP ! ***PP***
377
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
404 c LOGICAL TRKVERBOSE
405 c COMMON/TRKD/TRKVERBOSE
406 LOGICAL TRKDEBUG,TRKVERBOSE
407 COMMON/TRKD/TRKDEBUG,TRKVERBOSE
408 *
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 IF(TRKVERBOSE)
418 $ PRINT *,'CHISQ ==> error from trk routine POSXYZ !!'
419 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 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 ENDDO
479 c$$$ print*,'CHISQ ',chi2
480 * ------------------------------------------------
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 IF(TRKVERBOSE)
499 *23456789012345678901234567890123456789012345678901234567890123456789012
500 $ PRINT *,'CHISQ ==> error from trk routine POSXYZ'
501 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 IF(TRKVERBOSE)
513 $ PRINT *,'CHISQ ==> error from trk routine POSXYZ'
514 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 IF(TRKVERBOSE)PRINT *,'=== WARNING ===> COSTHE=0'
545 IFAIL=1
546 RETURN
547 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
631 c LOGICAL TRKVERBOSE
632 c COMMON/TRKD/TRKVERBOSE
633 LOGICAL TRKDEBUG,TRKVERBOSE
634 COMMON/TRKD/TRKDEBUG,TRKVERBOSE
635 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
655 c$$$ print*,'POSXY (prima) ',vout
656
657 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 if(TRKVERBOSE)
668 $ PRINT *,'posxy (grkuta): WARNING ===> backward track!!'
669 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 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
691 * -----------------------------------------------
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 c$$$ print*,'POSXY (dopo) ',vout
703
704
705 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
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 IFLAG=0 !no debug mode
816 CALL TRICIRCLE(NP,XP,ZP,AP,RP,CHI,XC,ZC,RADIUS,IFLAG)
817 c print*,' circle: ',XC,ZC,RADIUS,' --- ',CHI,IFLAG
818 IF(IFLAG.NE.0)GOTO 10 !straigth fit
819 if(CHI.gt.100)GOTO 10 !straigth fit
820 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
829 IF(ABS(X0).GT.30)THEN
830 c$$$ PRINT*,'STRANGE GUESS: XC,ZC,R ',XC,ZC,RADIUS
831 c$$$ $ ,' - CHI ',CHI,' - X0,AX,DEF ',X0,AX,DEF
832 GOTO 10 !straigth fit
833 ENDIF
834 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 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 ENDIF
909 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 AL(5) = DEF
913
914 c print*,' guess: ',(al(i),i=1,5)
915
916 end

  ViewVC Help
Powered by ViewVC 1.1.23