/[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.7 - (show annotations) (download)
Wed Nov 15 14:54:06 2006 UTC (18 years, 1 month ago) by pam-fi
Branch: MAIN
Changes since 1.6: +15 -39 lines
back to previous version

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 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 if(TRKDEBUG) print*,'guess: ',al
124 if(TRKDEBUG) print*,'mini2: step ',istep,chi2,1./AL(5)
125
126 *
127 * -----------------------
128 * START MINIMIZATION LOOP
129 * -----------------------
130 10 ISTEP=ISTEP+1 !<<<<<<<<<<<<<< NEW STEP !!
131
132 CALL CHISQ(IFLAG,JFAIL) !chi^2 and its derivatives
133 IF(JFAIL.NE.0) THEN
134 IFAIL=1
135 CHI2=-9999.
136 if(TRKVERBOSE)
137 $ PRINT *,'*** ERROR in mini *** wrong CHISQ'
138 RETURN
139 ENDIF
140
141 COST=1e-7
142 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
149 IF(PFIXED.EQ.0.) THEN
150
151 *------------------------------------------------------------*
152 * track fitting with FREE deflection
153 *------------------------------------------------------------*
154 CALL DSFACT(5,CHI2DD,5,IFA,DET,JFA) !CHI2DD matrix determinant
155 IF(IFA.NE.0) THEN !not positive-defined
156 if(TRKVERBOSE)then
157 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 * *******************************************
171 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 if(TRKVERBOSE)then
195 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 * *******************************************
207 * find new value of AL-pha
208 * *******************************************
209 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 ENDIF
221
222 if(TRKDEBUG) print*,'mini2: step ',istep,chi2,1./AL(5)
223
224 *------------------------------------------------------------*
225 * ---------------------------------------------------- *
226 *------------------------------------------------------------*
227 * check parameter bounds:
228 *------------------------------------------------------------*
229 DO I=1,5
230 IF(AL(I).GT.ALMAX(I).OR.AL(I).LT.ALMIN(I))THEN
231 if(TRKVERBOSE)then
232 PRINT*,' *** WARNING in mini *** '
233 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 IF(CHI2.EQ.0) CHI2=-9999.
239 IF(CHI2.GT.0) CHI2=-CHI2
240 IFAIL=1
241 RETURN
242 ENDIF
243 ENDDO
244 *------------------------------------------------------------*
245 * check number of steps:
246 *------------------------------------------------------------*
247 IF(ISTEP.ge.ISTEPMAX) then
248 c$$$ IFAIL=1
249 c$$$ if(TRKVERBOSE)
250 c$$$ $ PRINT *,'*** WARNING in mini *** ISTEP.GT.ISTEPMAX=',
251 c$$$ $ ISTEPMAX
252 goto 11
253 endif
254 *------------------------------------------------------------*
255 * ---------------------------------------------
256 * evaluate deflection tolerance on the basis of
257 * estimated deflection
258 * ---------------------------------------------
259 *------------------------------------------------------------*
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 *---- check tolerances:
268 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 DO I=1,5
274 IF(ABS(DAL(I)).GT.ALTOL(I))GOTO 10 !>>>> new step!
275 ENDDO
276
277 * 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 if(TRKVERBOSE)THEN
283 CHI2=-9999.
284 if(TRKVERBOSE)
285 $ 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 if(TRKVERBOSE)then
300 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 if(TRKVERBOSE)then
327 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
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 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 if(TRKVERBOSE)
360 $ print*,'*** WARNING *** in mini n.dof = 0 (set to 1)'
361 endif
362
363 if(TRKDEBUG) print*,'mini2: -ok- ',istep,chi2,1./AL(5)
364
365 * ------------------------------------
366 * Reduced chi^2
367 CHI2 = CHI2/dble(ndof)
368
369 c print*,'mini2: chi2 ',chi2
370
371 11 CONTINUE
372
373 NSTEP=ISTEP ! ***PP***
374
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
401 c LOGICAL TRKVERBOSE
402 c COMMON/TRKD/TRKVERBOSE
403 LOGICAL TRKDEBUG,TRKVERBOSE
404 COMMON/TRKD/TRKDEBUG,TRKVERBOSE
405 *
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 IF(TRKVERBOSE)
415 $ PRINT *,'CHISQ ==> error from trk routine POSXYZ !!'
416 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 c print*,'CHISQ ',chi2
469 * ------------------------------------------------
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 IF(TRKVERBOSE)
488 *23456789012345678901234567890123456789012345678901234567890123456789012
489 $ PRINT *,'CHISQ ==> error from trk routine POSXYZ'
490 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 IF(TRKVERBOSE)
502 $ PRINT *,'CHISQ ==> error from trk routine POSXYZ'
503 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 IF(TRKVERBOSE)PRINT *,'=== WARNING ===> COSTHE=0'
534 IFAIL=1
535 RETURN
536 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
620 c LOGICAL TRKVERBOSE
621 c COMMON/TRKD/TRKVERBOSE
622 LOGICAL TRKDEBUG,TRKVERBOSE
623 COMMON/TRKD/TRKDEBUG,TRKVERBOSE
624 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
644 c$$$ print*,'POSXY ',vout
645
646 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 if(TRKVERBOSE)
657 $ PRINT *,'posxy (grkuta): WARNING ===> backward track!!'
658 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 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
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