/[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.15 - (show annotations) (download)
Fri Apr 27 10:39:58 2007 UTC (17 years, 7 months ago) by pam-fi
Branch: MAIN
CVS Tags: v3r04, v3r03
Changes since 1.14: +6 -0 lines
v3r00: new hough parameters, new variables, and other things...

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

  ViewVC Help
Powered by ViewVC 1.1.23