/[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.3 - (show annotations) (download)
Thu Oct 26 16:22:37 2006 UTC (18 years, 3 months ago) by pam-fi
Branch: MAIN
Changes since 1.2: +201 -65 lines
fitting methods

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 (inf=1.e8) !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/inf,inf,inf,inf,0.25e2/ !limits on alpha vector components
45 c DATA ALMIN/-inf,-inf,-inf,-inf,-0.25e2/ !"
46 DATA ALMAX/inf,inf,1.,inf,0.25e2/ !limits on alpha vector components
47 DATA ALMIN/-inf,-inf,-1.,-inf,-0.25e2/ !"
48
49
50 DIMENSION DAL(5) !increment of vector alfa
51 DIMENSION CHI2DD_R(4,4),CHI2D_R(4) !hessiano e gradiente di chi2
52
53 INTEGER IFLAG
54 c--------------------------------------------------------
55 c IFLAG =1 ---- chi2 derivatives computed by using
56 c incremental ratios and posxyz.f
57 c IFLAG =2 ---- the approximation of Golden is used
58 c (see chisq.f)
59 c
60 c NB: the two metods gives equivalent results BUT
61 c method 2 is faster!!
62 c--------------------------------------------------------
63 DATA IFLAG/2/
64
65 LOGICAL TRKDEBUG
66 COMMON/TRKD/TRKDEBUG
67
68 IF(IPRINT.EQ.1) THEN
69 TRKDEBUG = .TRUE.
70 ELSE
71 TRKDEBUG = .FALSE.
72 ENDIF
73
74 * ----------------------------------------------------------
75 * define ALTOL(5) ---> tolerances on state vector
76 *
77 * ----------------------------------------------------------
78 FACT=10. !scale factor to define
79 !tolerance on alfa
80 ALTOL(1)=RESX(1)/FACT !al(1) = x
81 ALTOL(2)=RESY(1)/FACT !al(2) = y
82 ALTOL(3)=DSQRT(RESX(1)**2 !al(3)=sin(theta)
83 $ +RESY(1)**2)/44.51/FACT
84 ALTOL(4)=ALTOL(3) !al(4)=phi
85 c deflection error (see PDG)
86 DELETA1=0.01*RESX(1)/0.3/0.4/0.4451**2*SQRT(720./(6.+4.))
87 DELETA2=0.016/0.3/0.4/0.4451*SQRT(0.4451/9.36)
88 * ----------------------------------------------------------
89 *
90 ISTEP=0 !num. steps to minimize chi^2
91 JFAIL=0 !error flag
92 *
93 * -----------------------
94 * START MINIMIZATION LOOP
95 * -----------------------
96 10 ISTEP=ISTEP+1 !<<<<<<<<<<<<<< NEW STEP !!
97
98 CALL CHISQ(IFLAG,JFAIL) !chi^2 and its derivatives
99 IF(JFAIL.NE.0) THEN
100 IFAIL=1
101 CHI2=-9999.
102 if(TRKDEBUG)
103 $ PRINT *,'*** ERROR in mini *** wrong CHISQ'
104 RETURN
105 ENDIF
106
107 * CHI2_P=CHI2
108
109 c print*,'@@@@@ ',istep,' - ',al
110
111 COST=1e-7
112 DO I=1,5
113 DO J=1,5
114 CHI2DD(I,J)=CHI2DD(I,J)*COST
115 ENDDO
116 CHI2D(I)=CHI2D(I)*COST
117 ENDDO
118
119 IF(PFIXED.EQ.0.) THEN
120
121 *------------------------------------------------------------*
122 * track fitting with FREE deflection
123 *------------------------------------------------------------*
124 CALL DSFACT(5,CHI2DD,5,IFA,DET,JFA) !CHI2DD matrix determinant
125 IF(IFA.NE.0) THEN !not positive-defined
126 if(TRKDEBUG)then
127 PRINT *,
128 $ '*** ERROR in mini ***'//
129 $ 'on matrix inversion (not pos-def)'
130 $ ,DET
131 endif
132 IF(CHI2.EQ.0) CHI2=-9999.
133 IF(CHI2.GT.0) CHI2=-CHI2
134 IFAIL=1
135 RETURN
136 ENDIF
137 CALL DSFINV(5,CHI2DD,5) !CHI2DD matrix inversion
138 * *******************************************
139 * find new value of AL-pha
140 *
141 DO I=1,5
142 DAL(I)=0.
143 DO J=1,5
144 DAL(I)=DAL(I)-CHI2DD(I,J)*CHI2D(J)
145 COV(I,J)=2.*COST*CHI2DD(I,J)
146 ENDDO
147 ENDDO
148 DO I=1,5
149 AL(I)=AL(I)+DAL(I)
150 ENDDO
151 *------------------------------------------------------------*
152 * track fitting with FIXED deflection
153 *------------------------------------------------------------*
154 ELSE
155 AL(5)=1./PFIXED
156 DO I=1,4
157 CHI2D_R(I)=CHI2D(I)
158 DO J=1,4
159 CHI2DD_R(I,J)=CHI2DD(I,J)
160 ENDDO
161 ENDDO
162 CALL DSFACT(4,CHI2DD_R,4,IFA,DET,JFA)
163 IF(IFA.NE.0) THEN
164 if(TRKDEBUG)then
165 PRINT *,
166 $ '*** ERROR in mini ***'//
167 $ 'on matrix inversion (not pos-def)'
168 $ ,DET
169 endif
170 IF(CHI2.EQ.0) CHI2=-9999.
171 IF(CHI2.GT.0) CHI2=-CHI2
172 IFAIL=1
173 RETURN
174 ENDIF
175 CALL DSFINV(4,CHI2DD_R,4)
176 DO I=1,4
177 DAL(I)=0.
178 DO J=1,4
179 DAL(I)=DAL(I)-CHI2DD_R(I,J)*CHI2D_R(J)
180 COV(I,J)=2.*COST*CHI2DD_R(I,J)
181 ENDDO
182 ENDDO
183 DAL(5)=0.
184 DO I=1,4
185 AL(I)=AL(I)+DAL(I)
186 ENDDO
187 ENDIF
188 *------------------------------------------------------------*
189 * ---------------------------------------------------- *
190 *------------------------------------------------------------*
191 * *******************************************
192 * check parameter bounds:
193 DO I=1,5
194 IF(AL(I).GT.ALMAX(I).OR.AL(I).LT.ALMIN(I))THEN
195 if(TRKDEBUG)then
196 PRINT*,' *** WARNING in mini *** '
197 PRINT*,'MINI_2 ==> AL(',I,') out of range'
198 PRINT*,' value: ',AL(I),
199 $ ' limits: ',ALMIN(I),ALMAX(I)
200 print*,'istep ',istep
201 endif
202 IF(CHI2.EQ.0) CHI2=-9999.
203 IF(CHI2.GT.0) CHI2=-CHI2
204 IFAIL=1
205 RETURN
206 ENDIF
207 ENDDO
208
209 * check number of steps:
210 IF(ISTEP.gt.ISTEPMAX) then
211 IFAIL=1
212 if(TRKDEBUG)
213 $ PRINT *,'*** WARNING in mini *** ISTEP.GT.ISTEPMAX=',
214 $ ISTEPMAX
215 goto 11
216 endif
217 * ---------------------------------------------
218 * evaluate deflection tolerance on the basis of
219 * estimated deflection
220 * ---------------------------------------------
221 ALTOL(5)=DSQRT(DELETA1**2+DELETA2**2*AL(5)**2)/FACT
222 *---- check tolerances:
223 DO I=1,5
224 IF(ABS(DAL(I)).GT.ALTOL(I))GOTO 10 !>>>> new step!
225 ENDDO
226
227 * new estimate of chi^2:
228 JFAIL=0 !error flag
229 CALL CHISQ(IFLAG,JFAIL) !chi^2 and its derivatives
230 IF(JFAIL.NE.0) THEN
231 IFAIL=1
232 if(TRKDEBUG)THEN
233 CHI2=-9999.
234 if(TRKDEBUG)
235 $ PRINT *,'*** ERROR in mini *** wrong CHISQ'
236 ENDIF
237 RETURN
238 ENDIF
239 COST=1e-7
240 DO I=1,5
241 DO J=1,5
242 CHI2DD(I,J)=CHI2DD(I,J)*COST
243 ENDDO
244 CHI2D(I)=CHI2D(I)*COST
245 ENDDO
246 IF(PFIXED.EQ.0.) THEN
247 CALL DSFACT(5,CHI2DD,5,IFA,DET,JFA) !CHI2DD matrix determinant
248 IF(IFA.NE.0) THEN !not positive-defined
249 if(TRKDEBUG)then
250 PRINT *,
251 $ '*** ERROR in mini ***'//
252 $ 'on matrix inversion (not pos-def)'
253 $ ,DET
254 endif
255 IF(CHI2.EQ.0) CHI2=-9999.
256 IF(CHI2.GT.0) CHI2=-CHI2
257 IFAIL=1
258 RETURN
259 ENDIF
260 CALL DSFINV(5,CHI2DD,5) !CHI2DD matrix inversion
261 DO I=1,5
262 DAL(I)=0.
263 DO J=1,5
264 COV(I,J)=2.*COST*CHI2DD(I,J)
265 ENDDO
266 ENDDO
267 ELSE
268 DO I=1,4
269 CHI2D_R(I)=CHI2D(I)
270 DO J=1,4
271 CHI2DD_R(I,J)=CHI2DD(I,J)
272 ENDDO
273 ENDDO
274 CALL DSFACT(4,CHI2DD_R,4,IFA,DET,JFA)
275 IF(IFA.NE.0) THEN
276 if(TRKDEBUG)then
277 PRINT *,
278 $ '*** ERROR in mini ***'//
279 $ 'on matrix inversion (not pos-def)'
280 $ ,DET
281 endif
282 IF(CHI2.EQ.0) CHI2=-9999.
283 IF(CHI2.GT.0) CHI2=-CHI2
284 IFAIL=1
285 RETURN
286 ENDIF
287 CALL DSFINV(4,CHI2DD_R,4)
288 DO I=1,4
289 DAL(I)=0.
290 DO J=1,4
291 COV(I,J)=2.*COST*CHI2DD_R(I,J)
292 ENDDO
293 ENDDO
294 ENDIF
295 *****************************
296
297 * ------------------------------------
298 * Number of Degree Of Freedom
299 ndof=0
300 do ip=1,nplanes
301 ndof=ndof
302 $ +int(xgood(ip))
303 $ +int(ygood(ip))
304 enddo
305 if(pfixed.eq.0.) ndof=ndof-5 ! ***PP***
306 if(pfixed.ne.0.) ndof=ndof-4 ! ***PP***
307 if(ndof.le.0.) then
308 ndof = 1
309 if(TRKDEBUG)
310 $ print*,'*** WARNING *** in mini n.dof = 0 (set to 1)'
311 endif
312 * ------------------------------------
313 * Reduced chi^2
314 CHI2 = CHI2/dble(ndof)
315
316 11 CONTINUE
317
318 NSTEP=ISTEP ! ***PP***
319
320 RETURN
321 END
322
323 ******************************************************************************
324 *
325 * routine to compute chi^2 and its derivatives
326 *
327 *
328 * (modified in respect to the previous one in order to include
329 * single clusters. In this case the residual is evaluated by
330 * calculating the distance between the track intersection and the
331 * segment AB associated to the single cluster)
332 *
333 ******************************************************************************
334
335 SUBROUTINE CHISQ(IFLAG,IFAIL)
336
337 IMPLICIT DOUBLE PRECISION (A-H,O-Z)
338
339 include 'commontracker.f' !tracker general common
340 include 'common_mini_2.f' !common for the tracking procedure
341
342 DIMENSION XV2(nplanes),YV2(nplanes),XV1(nplanes),YV1(nplanes)
343 $ ,XV0(nplanes),YV0(nplanes)
344 DIMENSION AL_P(5)
345
346 LOGICAL TRKDEBUG
347 COMMON/TRKD/TRKDEBUG
348 *
349 * chi^2 computation
350 *
351 DO I=1,5
352 AL_P(I)=AL(I)
353 ENDDO
354 JFAIL=0 !error flag
355 CALL POSXYZ(AL_P,JFAIL) !track intersection with tracking planes
356 IF(JFAIL.NE.0) THEN
357 IF(TRKDEBUG)
358 $ PRINT *,'CHISQ ==> error from trk routine POSXYZ !!'
359 IFAIL=1
360 RETURN
361 ENDIF
362 DO I=1,nplanes
363 XV0(I)=XV(I)
364 YV0(I)=YV(I)
365 ENDDO
366 * ------------------------------------------------
367 c$$$ CHI2=0.
368 c$$$ DO I=1,nplanes
369 c$$$ CHI2=CHI2
370 c$$$ + +(XV(I)-XM(I))**2/RESX(i)**2 *XGOOD(I)*YGOOD(I)
371 c$$$ + +(YV(I)-YM(I))**2/RESY(i)**2 *YGOOD(I)*XGOOD(I)
372 c$$$ ENDDO
373 * ---------------------------------------------------------
374 * For planes with only a X or Y-cl included, instead of
375 * a X-Y couple, the residual for chi^2 calculation is
376 * evaluated by finding the point x-y, along the segment AB,
377 * closest to the track.
378 * The X or Y coordinate, respectivelly for X and Y-cl, is
379 * then assigned to XM or YM, which is then considered the
380 * measured position of the cluster.
381 * ---------------------------------------------------------
382 CHI2=0.
383 DO I=1,nplanes
384 IF(XGOOD(I).EQ.1.AND.YGOOD(I).EQ.0)THEN !X-cl
385 BETA = (XM_B(I)-XM_A(I))/(YM_B(I)-YM_A(I))
386 ALFA = XM_A(I) - BETA * YM_A(I)
387 YM(I) = ( YV(I) + BETA*XV(I) - BETA*ALFA )/(1+BETA**2)
388 if(YM(I).lt.dmin1(YM_A(I),YM_B(I)))
389 $ YM(I)=dmin1(YM_A(I),YM_B(I))
390 if(YM(I).gt.dmax1(YM_A(I),YM_B(I)))
391 $ YM(I)=dmax1(YM_A(I),YM_B(I))
392 XM(I) = ALFA + BETA * YM(I) !<<<< measured coordinates
393 ELSEIF(XGOOD(I).EQ.0.AND.YGOOD(I).EQ.1)THEN !Y-cl
394 BETA = (YM_B(I)-YM_A(I))/(XM_B(I)-XM_A(I))
395 ALFA = YM_A(I) - BETA * XM_A(I)
396 XM(I) = ( XV(I) + BETA*YV(I) - BETA*ALFA )/(1+BETA**2)
397 if(XM(I).lt.dmin1(XM_A(I),XM_B(I)))
398 $ XM(I)=dmin1(XM_A(I),XM_B(I))
399 if(XM(I).gt.dmax1(XM_A(I),XM_B(I)))
400 $ XM(I)=dmax1(XM_A(I),XM_B(I))
401 YM(I) = ALFA + BETA * XM(I) !<<<< measured coordinates
402 ENDIF
403 CHI2=CHI2
404 + +(XV(I)-XM(I))**2/RESX(i)**2 *( XGOOD(I)*YGOOD(I) )
405 + +(YV(I)-YM(I))**2/RESY(i)**2 *( YGOOD(I)*XGOOD(I) )
406 + +((XV(I)-XM(I))**2+(YV(I)-YM(I))**2)/RESX(i)**2
407 + *( XGOOD(I)*(1-YGOOD(I)) )
408 + +((XV(I)-XM(I))**2+(YV(I)-YM(I))**2)/RESY(i)**2
409 + *( (1-XGOOD(I))*YGOOD(I) )
410 ENDDO
411 * ------------------------------------------------
412 *
413 * calculation of derivatives (dX/dAL_fa and dY/dAL_fa)
414 *
415 * //////////////////////////////////////////////////
416 * METHOD 1 -- incremental ratios
417 * //////////////////////////////////////////////////
418
419 IF(IFLAG.EQ.1) THEN
420
421 DO J=1,5
422 DO JJ=1,5
423 AL_P(JJ)=AL(JJ)
424 ENDDO
425 AL_P(J)=AL_P(J)+STEPAL(J)/2.
426 JFAIL=0
427 CALL POSXYZ(AL_P,JFAIL)
428 IF(JFAIL.NE.0) THEN
429 IF(TRKDEBUG)
430 *23456789012345678901234567890123456789012345678901234567890123456789012
431 $ PRINT *,'CHISQ ==> error from trk routine POSXYZ'
432 IFAIL=1
433 RETURN
434 ENDIF
435 DO I=1,nplanes
436 XV2(I)=XV(I)
437 YV2(I)=YV(I)
438 ENDDO
439 AL_P(J)=AL_P(J)-STEPAL(J)
440 JFAIL=0
441 CALL POSXYZ(AL_P,JFAIL)
442 IF(JFAIL.NE.0) THEN
443 IF(TRKDEBUG)
444 $ PRINT *,'CHISQ ==> error from trk routine POSXYZ'
445 IFAIL=1
446 RETURN
447 ENDIF
448 DO I=1,nplanes
449 XV1(I)=XV(I)
450 YV1(I)=YV(I)
451 ENDDO
452 DO I=1,nplanes
453 DXDAL(I,J)=(XV2(I)-XV1(I))/STEPAL(J)
454 DYDAL(I,J)=(YV2(I)-YV1(I))/STEPAL(J)
455 ENDDO
456 ENDDO
457
458 ENDIF
459
460 * //////////////////////////////////////////////////
461 * METHOD 2 -- Bob Golden
462 * //////////////////////////////////////////////////
463
464 IF(IFLAG.EQ.2) THEN
465
466 DO I=1,nplanes
467 DXDAL(I,1)=1.
468 DYDAL(I,1)=0.
469
470 DXDAL(I,2)=0.
471 DYDAL(I,2)=1.
472
473 COSTHE=DSQRT(1.-AL(3)**2)
474 IF(COSTHE.EQ.0.) THEN
475 IF(TRKDEBUG)PRINT *,'=== WARNING ===> COSTHE=0'
476 IFAIL=1
477 RETURN
478 ENDIF
479
480 DXDAL(I,3)=(ZINI-ZM(I))*DCOS(AL(4))/COSTHE**3
481 DYDAL(I,3)=(ZINI-ZM(I))*DSIN(AL(4))/COSTHE**3
482
483 DXDAL(I,4)=-AL(3)*(ZINI-ZM(I))*DSIN(AL(4))/COSTHE
484 DYDAL(I,4)=AL(3)*(ZINI-ZM(I))*DCOS(AL(4))/COSTHE
485
486 IF(AL(5).NE.0.) THEN
487 DXDAL(I,5)=
488 + (XV(I)-(AL(1)+AL(3)/COSTHE*(ZINI-ZM(I))
489 + *DCOS(AL(4))))/AL(5)
490 DYDAL(I,5)=
491 + (YV(I)-(AL(2)+AL(3)/COSTHE*(ZINI-ZM(I))
492 + *DSIN(AL(4))))/AL(5)
493 ELSE
494 DXDAL(I,5)=100.*( 0.25 *0.3*0.4*(0.01*(ZINI-ZM(I)))**2 )
495 DYDAL(I,5)=0.
496 ENDIF
497
498 ENDDO
499 ENDIF
500 *
501 * 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
502 * >>> CHI2D evaluation
503 *
504 DO J=1,5
505 CHI2D(J)=0.
506 DO I=1,nplanes
507 CHI2D(J)=CHI2D(J)
508 + +2.*(XV0(I)-XM(I))/RESX(i)**2*DXDAL(I,J) *XGOOD(I)
509 + +2.*(YV0(I)-YM(I))/RESY(i)**2*DYDAL(I,J) *YGOOD(I)
510 ENDDO
511 ENDDO
512 *
513 * >>> CHI2DD evaluation
514 *
515 DO I=1,5
516 DO J=1,5
517 CHI2DD(I,J)=0.
518 DO K=1,nplanes
519 CHI2DD(I,J)=CHI2DD(I,J)
520 + +2.*DXDAL(K,I)*DXDAL(K,J)/RESX(k)**2 *XGOOD(K)
521 + +2.*DYDAL(K,I)*DYDAL(K,J)/RESY(k)**2 *YGOOD(K)
522 ENDDO
523 ENDDO
524 ENDDO
525 * 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
526
527 RETURN
528 END
529
530
531 *****************************************************************
532 *
533 * Routine to compute the track intersection points
534 * on the tracking-system planes, given the track parameters
535 *
536 * The routine is based on GRKUTA, which computes the
537 * trajectory of a charged particle in a magnetic field
538 * by solving the equatins of motion with Runge-Kuta method.
539 *
540 * Variables that have to be assigned when the subroutine
541 * is called are:
542 *
543 * ZM(1,NPLANES) ----> z coordinates of the planes
544 * AL_P(1,5) ----> track-parameter vector
545 *
546 * -----------------------------------------------------------
547 * NB !!!
548 * The routine works properly only if the
549 * planes are numbered in descending order starting from the
550 * reference plane (ZINI)
551 * -----------------------------------------------------------
552 *
553 *****************************************************************
554
555 SUBROUTINE POSXYZ(AL_P,IFAIL)
556
557 IMPLICIT DOUBLE PRECISION (A-H,O-Z)
558
559 include 'commontracker.f' !tracker general common
560 include 'common_mini_2.f' !common for the tracking procedure
561
562 LOGICAL TRKDEBUG
563 COMMON/TRKD/TRKDEBUG
564 c
565 DIMENSION AL_P(5)
566 *
567 DO I=1,nplanes
568 ZV(I)=ZM(I) !
569 ENDDO
570 *
571 * set parameters for GRKUTA
572 *
573 IF(AL_P(5).NE.0) CHARGE=AL_P(5)/DABS(AL_P(5))
574 IF(AL_P(5).EQ.0) CHARGE=1.
575 VOUT(1)=AL_P(1)
576 VOUT(2)=AL_P(2)
577 VOUT(3)=ZINI ! DBLE(Z0)-DBLE(ZSPEC)
578 VOUT(4)=AL_P(3)*DCOS(AL_P(4))
579 VOUT(5)=AL_P(3)*DSIN(AL_P(4))
580 VOUT(6)=-1.*DSQRT(1.-AL_P(3)**2)
581 IF(AL_P(5).NE.0.) VOUT(7)=DABS(1./AL_P(5))
582 IF(AL_P(5).EQ.0.) VOUT(7)=1.E8
583 DO I=1,nplanes
584 step=vout(3)-zv(i)
585 10 DO J=1,7
586 VECT(J)=VOUT(J)
587 VECTINI(J)=VOUT(J)
588 ENDDO
589 11 continue
590 CALL GRKUTA(CHARGE,STEP,VECT,VOUT)
591 IF(VOUT(3).GT.VECT(3)) THEN
592 IFAIL=1
593 if(TRKDEBUG)
594 $ PRINT *,'posxy (grkuta): WARNING ===> backward track!!'
595 if(.TRUE.)print*,'charge',charge
596 if(.TRUE.)print*,'vect',vect
597 if(.TRUE.)print*,'vout',vout
598 if(.TRUE.)print*,'step',step
599 RETURN
600 ENDIF
601 Z=VOUT(3)
602 IF(Z.LE.ZM(I)+TOLL.AND.Z.GE.ZM(I)-TOLL) GOTO 100
603 IF(Z.GT.ZM(I)+TOLL) GOTO 10
604 IF(Z.LE.ZM(I)-TOLL) THEN
605 STEP=STEP*(ZM(I)-VECT(3))/(Z-VECT(3))
606 DO J=1,7
607 VECT(J)=VECTINI(J)
608 ENDDO
609 GOTO 11
610 ENDIF
611
612 * -----------------------------------------------
613 * evaluate track coordinates
614 100 XV(I)=VOUT(1)
615 YV(I)=VOUT(2)
616 ZV(I)=VOUT(3)
617 AXV(I)=DATAN(VOUT(4)/VOUT(6))*180./ACOS(-1.)
618 AYV(I)=DATAN(VOUT(5)/VOUT(6))*180./ACOS(-1.)
619 * -----------------------------------------------
620
621 ENDDO
622
623 RETURN
624 END
625
626
627
628
629
630 * **********************************************************
631 * Some initialization routines
632 * **********************************************************
633
634 * ----------------------------------------------------------
635 * Routine to initialize COMMON/TRACK/
636 *
637 subroutine track_init
638
639 IMPLICIT DOUBLE PRECISION (A-H,O-Z)
640
641 include 'commontracker.f' !tracker general common
642 include 'common_mini_2.f' !common for the tracking procedure
643 include 'common_mech.f'
644
645 do i=1,5
646 AL(i) = 0.
647 enddo
648
649 do ip=1,NPLANES
650 ZM(IP) = fitz(nplanes-ip+1) !init to mech. position
651 XM(IP) = -100. !0.
652 YM(IP) = -100. !0.
653 XM_A(IP) = -100. !0.
654 YM_A(IP) = -100. !0.
655 c ZM_A(IP) = 0
656 XM_B(IP) = -100. !0.
657 YM_B(IP) = -100. !0.
658 c ZM_B(IP) = 0
659 RESX(IP) = 1000. !3.d-4
660 RESY(IP) = 1000. !12.d-4
661 XGOOD(IP) = 0
662 YGOOD(IP) = 0
663 enddo
664
665 return
666 end

  ViewVC Help
Powered by ViewVC 1.1.23