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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by pam-fi, Thu Oct 26 16:22:37 2006 UTC revision 1.21 by pam-fi, Fri Apr 11 13:44:38 2008 UTC
# Line 22  Line 22 
22  c      logical DEBUG  c      logical DEBUG
23  c      common/dbg/DEBUG  c      common/dbg/DEBUG
24    
25        parameter (inf=1.e8)      !just a huge number...        parameter (dinf=1.d15)      !just a huge number...
26  c------------------------------------------------------------------------  c------------------------------------------------------------------------
27  c     variables used in the tracking procedure (mini and its subroutines)  c     variables used in the tracking procedure (mini and its subroutines)
28  c  c
# Line 41  c      DATA XGOOD,YGOOD/nplanes*1.,nplan Line 41  c      DATA XGOOD,YGOOD/nplanes*1.,nplan
41  *                               !the tracking procedure  *                               !the tracking procedure
42        DATA STEPMAX/100./        !maximum number of steps in the trackin gprocess        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  c      DATA ALMAX/dinf,dinf,1.,dinf,dinf/ !limits on alpha vector components
45  c      DATA ALMIN/-inf,-inf,-inf,-inf,-0.25e2/ !"  c      DATA ALMIN/-dinf,-dinf,-1.,-dinf,-dinf/ !"
46        DATA ALMAX/inf,inf,1.,inf,0.25e2/      !limits on alpha vector components        DATA ALMAX/dinf,dinf,1.,dinf,dinf/ !limits on alpha vector components
47        DATA ALMIN/-inf,-inf,-1.,-inf,-0.25e2/ !"        DATA ALMIN/-dinf,-dinf,-1.,-dinf,-dinf/ !"
48    
49    c$$$      DIMENSION DAL(5)                    !increment of vector alfa
       DIMENSION DAL(5)                    !increment of vector alfa  
50        DIMENSION CHI2DD_R(4,4),CHI2D_R(4) !hessiano e gradiente di chi2        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                    INTEGER IFLAG            
57  c--------------------------------------------------------  c--------------------------------------------------------
58  c     IFLAG =1 ---- chi2 derivatives computed by using  c     IFLAG =1 ---- chi2 derivatives computed by using
# Line 62  c     method 2 is faster!! Line 65  c     method 2 is faster!!
65  c--------------------------------------------------------  c--------------------------------------------------------
66        DATA IFLAG/2/          DATA IFLAG/2/  
67                    
68        LOGICAL TRKDEBUG  c      LOGICAL TRKDEBUG,TRKVERBOSE
69        COMMON/TRKD/TRKDEBUG  c      COMMON/TRKD/TRKDEBUG,TRKVERBOSE
70          LOGICAL TRKDEBUG,TRKVERBOSE,STUDENT,FIRSTSTEPS,FIRSTSTUDENT
71          COMMON/TRKD/TRKDEBUG,TRKVERBOSE
72    
73          DIMENSION AL0(5)
74          LOGICAL SUCCESS_NEW,SUCCESS_OLD
75    
76    c$$$      PRINT*,'==========' ! TEST
77    c$$$      PRINT*,'START MINI' ! TEST
78    c$$$      PRINT*,'==========' ! TEST
79    
80    *
81    *     define kind of minimization (0x=chi2+gaussian or 1x=likelihood+student)
82    *
83          STUDENT = .false.
84          FIRSTSTEPS = .true.
85          FIRSTSTUDENT = .true.
86          IF(MOD(INT(TRACKMODE/10),10).EQ.1) STUDENT = .true.
87    
88        IF(IPRINT.EQ.1) THEN        IF(IPRINT.EQ.1) THEN
89           TRKDEBUG = .TRUE.           TRKVERBOSE = .TRUE.
90             TRKDEBUG   = .FALSE.
91          ELSEIF(IPRINT.EQ.2)THEN
92             TRKVERBOSE = .TRUE.
93             TRKDEBUG   = .TRUE.
94        ELSE        ELSE
95           TRKDEBUG = .FALSE.           TRKVERBOSE = .FALSE.
96             TRKDEBUG   = .FALSE.
97        ENDIF                ENDIF        
98    
99  *     ----------------------------------------------------------  *     ----------------------------------------------------------
100    *     evaluate average spatial resolution
101    *     ----------------------------------------------------------
102          AVRESX = RESXAV
103          AVRESY = RESYAV
104          NX = 0.0
105          NY = 0.0
106          DO IP=1,6
107             IF( XGOOD(IP).EQ.1 )THEN
108                NX=NX+1.0
109                AVRESX=AVRESX+RESX(IP)
110             ENDIF
111             IF( YGOOD(IP).EQ.1 )THEN
112                NY=NY+1.0
113                AVRESY=AVRESY+RESY(IP)
114             ENDIF
115          ENDDO
116          IF(NX.NE.0.0)AVRESX=AVRESX/NX
117          IF(NY.NE.0.0)AVRESY=AVRESY/NY        
118    
119    *     ----------------------------------------------------------
120  *     define ALTOL(5) ---> tolerances on state vector  *     define ALTOL(5) ---> tolerances on state vector
121  *      *    
122  *     ----------------------------------------------------------  *     ----------------------------------------------------------
123        FACT=10.                  !scale factor to define  *     changed in order to evaluate energy-dependent
124                                  !tolerance on alfa  *     tolerances on all 5 parameters
125        ALTOL(1)=RESX(1)/FACT     !al(1) = x  cPP      FACT=1.0e10                  !scale factor to define tolerance on alfa
       ALTOL(2)=RESY(1)/FACT     !al(2) = y  
       ALTOL(3)=DSQRT(RESX(1)**2 !al(3)=sin(theta)  
      $     +RESY(1)**2)/44.51/FACT  
       ALTOL(4)=ALTOL(3)         !al(4)=phi  
126  c     deflection error (see PDG)  c     deflection error (see PDG)
127        DELETA1=0.01*RESX(1)/0.3/0.4/0.4451**2*SQRT(720./(6.+4.))        DELETA1 = 0.01/0.3/0.4/0.4451**2*SQRT(720./(6.+4.))
128        DELETA2=0.016/0.3/0.4/0.4451*SQRT(0.4451/9.36)        DELETA2 = 0.016/0.3/0.4/0.4451*SQRT(0.4451/9.36)
129    c$$$      ALTOL(1) = AVRESX/FACT     !al(1) = x
130    c$$$      ALTOL(2) = AVRESY/FACT     !al(2) = y
131    c$$$      ALTOL(3) = DSQRT(AVRESX**2 !al(3)=sin(theta)
132    c$$$     $     +AVRESY**2)/44.51/FACT
133    c$$$      ALTOL(4) = ALTOL(3)         !al(4)=phi
134    c     deflection error (see PDG)
135    c$$$      DELETA1 = 0.01*AVRESX/0.3/0.4/0.4451**2*SQRT(720./(6.+4.))
136    c$$$      DELETA2 = 0.016/0.3/0.4/0.4451*SQRT(0.4451/9.36)
137  *     ----------------------------------------------------------  *     ----------------------------------------------------------
138  *      *    
139        ISTEP=0                   !num. steps to minimize chi^2        ISTEP=0                   !num. steps to minimize chi^2
140        JFAIL=0                   !error flag        JFAIL=0                   !error flag
141          CHI2=0
142    
143          if(TRKDEBUG) print*,'guess: ',al
144          if(TRKDEBUG) print*,'mini2: step ',istep,chi2,1./AL(5)
145    
146  *      *    
147  *     -----------------------  *     -----------------------
148  *     START MINIMIZATION LOOP  *     START MINIMIZATION LOOP
149  *     -----------------------  *     -----------------------
150   10   ISTEP=ISTEP+1             !<<<<<<<<<<<<<< NEW STEP !!   10   ISTEP=ISTEP+1             !<<<<<<<<<<<<<< NEW STEP !!
151    
152        CALL CHISQ(IFLAG,JFAIL)   !chi^2 and its derivatives  * -------------------------------
153        IF(JFAIL.NE.0) THEN  * **** Chi2+gaussian minimization
154           IFAIL=1  * -------------------------------
          CHI2=-9999.  
          if(TRKDEBUG)  
      $        PRINT *,'*** ERROR in mini *** wrong CHISQ'  
          RETURN  
       ENDIF  
         
 *      CHI2_P=CHI2  
         
 c      print*,'@@@@@ ',istep,' - ',al  
155    
156        COST=1e-7        IF((.NOT.STUDENT).OR.FIRSTSTEPS) THEN
157        DO I=1,5  
158           DO J=1,5           IF(ISTEP.GE.3) FIRSTSTEPS = .false.
159              CHI2DD(I,J)=CHI2DD(I,J)*COST  
160             CALL CHISQ(IFLAG,JFAIL) !chi^2 and its derivatives
161             IF(JFAIL.NE.0) THEN
162                IFAIL=1
163                CHI2=-9999.
164                if(TRKVERBOSE)
165         $           PRINT *,'*** ERROR in mini *** wrong CHISQ'
166                RETURN
167             ENDIF
168            
169    c      COST=1e-5
170             COST=1.
171             DO I=1,5
172                IF(CHI2DD(I,I).NE.0.)COST=COST/DABS(CHI2DD(I,I))**0.2
173             ENDDO
174             DO I=1,5
175                DO J=1,5
176                   CHI2DD(I,J)=CHI2DD(I,J)*COST
177                ENDDO
178    c$$$            CHI2D(I)=CHI2D(I)*COST
179           ENDDO           ENDDO
          CHI2D(I)=CHI2D(I)*COST  
       ENDDO        
180    
181        IF(PFIXED.EQ.0.) THEN           IF(PFIXED.EQ.0.) THEN
182    
183  *------------------------------------------------------------*  *------------------------------------------------------------*
184  *     track fitting with FREE deflection  *     track fitting with FREE deflection
185  *------------------------------------------------------------*  *------------------------------------------------------------*
186           CALL DSFACT(5,CHI2DD,5,IFA,DET,JFA) !CHI2DD matrix determinant              CALL DSFACT(5,CHI2DD,5,IFA,DET,JFA) !CHI2DD matrix determinant
187           IF(IFA.NE.0) THEN      !not positive-defined                    IF(IFA.NE.0) THEN   !not positive-defined      
188              if(TRKDEBUG)then                 if(TRKVERBOSE)then
189                 PRINT *,                    PRINT *,
190       $              '*** ERROR in mini ***'//       $                 '*** ERROR in mini ***'//
191       $              'on matrix inversion (not pos-def)'       $                 'on matrix inversion (not pos-def)'
192       $              ,DET       $                 ,DET
193              endif                 endif
194              IF(CHI2.EQ.0) CHI2=-9999.                 IF(CHI2.EQ.0) CHI2=-9999.
195              IF(CHI2.GT.0) CHI2=-CHI2                 IF(CHI2.GT.0) CHI2=-CHI2
196              IFAIL=1                 IFAIL=1
197              RETURN                             RETURN            
198           ENDIF              ENDIF
199           CALL DSFINV(5,CHI2DD,5) !CHI2DD matrix inversion                  CALL DSFINV(5,CHI2DD,5) !CHI2DD matrix inversion    
200    *     *******************************************
201    *     find new value of AL-pha                
202    *     *******************************************                                        
203                DO I=1,5                              
204                   DAL(I)=0.          
205                   DO J=1,5            
206                      DAL(I)=DAL(I)-CHI2DD(I,J)*CHI2D(J)  *COST
207                      COV(I,J)=2.*COST*CHI2DD(I,J)
208                   ENDDO  
209                ENDDO                  
210                DO I=1,5              
211                   AL(I)=AL(I)+DAL(I)  
212                ENDDO                  
213    *------------------------------------------------------------*
214    *     track fitting with FIXED deflection
215    *------------------------------------------------------------*
216             ELSE
217                AL(5)=1./PFIXED
218                DO I=1,4
219                   CHI2D_R(I)=CHI2D(I)
220                   DO J=1,4
221                      CHI2DD_R(I,J)=CHI2DD(I,J)
222                   ENDDO
223                ENDDO
224                CALL DSFACT(4,CHI2DD_R,4,IFA,DET,JFA)
225                IF(IFA.NE.0) THEN
226                   if(TRKVERBOSE)then
227                      PRINT *,
228         $                 '*** ERROR in mini ***'//
229         $                 'on matrix inversion (not pos-def)'
230         $                 ,DET
231                   endif
232                   IF(CHI2.EQ.0) CHI2=-9999.
233                   IF(CHI2.GT.0) CHI2=-CHI2
234                   IFAIL=1
235                   RETURN            
236                ENDIF
237                CALL DSFINV(4,CHI2DD_R,4)
238  *     *******************************************  *     *******************************************
239  *     find new value of AL-pha                  *     find new value of AL-pha                
240  *                                                *     *******************************************                                        
241                DO I=1,4
242                   DAL(I)=0.
243                   DO J=1,4
244                      DAL(I)=DAL(I)-CHI2DD_R(I,J)*CHI2D_R(J)  *COST
245                      COV(I,J)=2.*COST*CHI2DD_R(I,J)
246                   ENDDO
247                ENDDO
248                DAL(5)=0.
249                DO I=1,4
250                   AL(I)=AL(I)+DAL(I)
251                ENDDO
252             ENDIF
253          
254             if(TRKDEBUG) print*,'mini2: step ',istep,chi2,1./AL(5)
255    
256    c$$$         PRINT*,'DAL ',(DAL(K),K=1,5)
257    c$$$         PRINT*,'CHI2DOLD ',(CHI2DOLD(K),K=1,5)
258    
259    
260          ENDIF
261    
262    * -------------------------------
263    * **** Likelihood+Student minimization
264    * -------------------------------
265    
266          IF(STUDENT.AND.(.NOT.FIRSTSTEPS)) THEN
267    
268             IF(FIRSTSTUDENT) THEN
269                FIRSTSTUDENT = .false.
270                ISTEP = 1
271             ENDIF
272    
273             CALL CHISQSTT(1,JFAIL)
274           DO I=1,5                                         DO I=1,5                              
275              DAL(I)=0.                        DAL(I)=0.          
276              DO J=1,5                          DO J=1,5            
277                 DAL(I)=DAL(I)-CHI2DD(I,J)*CHI2D(J)                 DAL(I)=DAL(I)-CHI2DD(I,J)*CHI2D(J)
278                 COV(I,J)=2.*COST*CHI2DD(I,J)              ENDDO  
             ENDDO                
          ENDDO                    
          DO I=1,5                
             AL(I)=AL(I)+DAL(I)    
279           ENDDO                             ENDDO                  
280  *------------------------------------------------------------*          
281  *     track fitting with FIXED deflection           DO I=1,5
282  *------------------------------------------------------------*              DO j=1,5
283        ELSE                 COV(I,J) = 2.*CHI2DD(I,J)
          AL(5)=1./PFIXED  
          DO I=1,4  
             CHI2D_R(I)=CHI2D(I)  
             DO J=1,4  
                CHI2DD_R(I,J)=CHI2DD(I,J)  
284              ENDDO              ENDDO
285           ENDDO           ENDDO
286           CALL DSFACT(4,CHI2DD_R,4,IFA,DET,JFA)          
287           IF(IFA.NE.0) THEN           CHI2TOLL = 1.E-3
288              if(TRKDEBUG)then           ALPHA = 3.0
289                 PRINT *,           BETA = -0.4
290       $              '*** ERROR in mini ***'//           E=1.
291       $              'on matrix inversion (not pos-def)'           EA=1.
292       $              ,DET           EB=1.
293              endif           EC=1.
294              IF(CHI2.EQ.0) CHI2=-9999.           FA=1.
295              IF(CHI2.GT.0) CHI2=-CHI2           FB=1.
296              IFAIL=1           FC=1.
297              RETURN                       SUCCESS_OLD = .FALSE.
298           ENDIF           SUCCESS_NEW = .FALSE.
299           CALL DSFINV(4,CHI2DD_R,4)  
300           DO I=1,4           CALL CHISQSTT(0,JFAIL)
301              DAL(I)=0.  c$$$         PRINT*,CHI2
302              DO J=1,4           CHI2_NEW = CHI2
303                 DAL(I)=DAL(I)-CHI2DD_R(I,J)*CHI2D_R(J)           FC = CHI2
304                 COV(I,J)=2.*COST*CHI2DD_R(I,J)           EC = 0.
305              ENDDO  
306             ICOUNT = 0
307     100     CONTINUE
308             ICOUNT = ICOUNT+1
309    
310             DO I=1,5
311                AL0(I)=AL(I)
312           ENDDO           ENDDO
313           DAL(5)=0.           DO I=1,5
314           DO I=1,4              AL(I)=AL(I)+E*DAL(I)
315              AL(I)=AL(I)+DAL(I)           ENDDO
316             CALL CHISQSTT(0,JFAIL)
317             CHI2_OLD = CHI2_NEW
318             CHI2_NEW = CHI2
319             FA = FB
320             FB = FC
321             FC = CHI2
322             EA = EB
323             EB = EC
324             EC = E
325    
326    c$$$         PRINT*,E,CHI2_NEW
327    
328             IF(CHI2_NEW.LE.CHI2_OLD) THEN ! success
329                IF(DABS(CHI2_NEW-CHI2_OLD).LT.CHI2TOLL) GOTO 101
330                SUCCESS_OLD = SUCCESS_NEW
331                SUCCESS_NEW = .TRUE.
332                E = E*ALPHA
333             ELSE                   ! failure
334                SUCCESS_OLD = SUCCESS_NEW
335                SUCCESS_NEW = .FALSE.
336                CHI2_NEW = CHI2_OLD
337                DO I=1,5
338                   AL(I)=AL0(I)
339                ENDDO
340                IF(SUCCESS_OLD) THEN
341                   DENOM = (EB-EA)*(FB-FC) - (EB-EC)*(FB-FA)
342                   IF(DENOM.NE.0.) THEN
343                      E = EB - 0.5*( (EB-EA)**2*(FB-FC)
344         $                 - (EB-EC)**2*(FB-FA) ) / DENOM
345                   ELSE
346                      E = BETA*E
347                   ENDIF
348                ELSE
349                   E = BETA*E
350                ENDIF
351    c$$$            E = BETA*E
352             ENDIF
353             IF(ICOUNT.GT.20) GOTO 101
354             GOTO 100
355    
356     101     CONTINUE
357    
358             DO I=1,5
359                DAL(I)=E*DAL(I)
360           ENDDO           ENDDO
361    
362    c$$$         print*,' '
363    c$$$         PRINT*,'DAL ',(DAL(K),K=1,5)
364    c$$$         PRINT*,'CHI2DOLD ',(CHI2DOLD(K),K=1,5)
365    c$$$         print*,'==== CHI2 ===='
366    c$$$         print*,chi2
367    c$$$         print*,'==== CHI2d ===='
368    c$$$         print*,(chi2d(i),i=1,5)
369    c$$$         print*,'==== CHI2dd ===='
370    c$$$         do j=1,5
371    c$$$            print*,(chi2dd(j,i),i=1,5)
372    c$$$         enddo
373    c$$$         print*,'================'
374    c$$$         print*,' '
375            
376    *========= FIN QUI =============
377    
378        ENDIF        ENDIF
379    
380            
381    
382    
383    
384  *------------------------------------------------------------*  *------------------------------------------------------------*
385  *     ----------------------------------------------------   *  *     ----------------------------------------------------   *
386  *------------------------------------------------------------*  *------------------------------------------------------------*
 *     *******************************************  
387  *     check parameter bounds:  *     check parameter bounds:
388    *------------------------------------------------------------*
389        DO I=1,5        DO I=1,5
390           IF(AL(I).GT.ALMAX(I).OR.AL(I).LT.ALMIN(I))THEN           IF(AL(I).GT.ALMAX(I).OR.AL(I).LT.ALMIN(I))THEN
391              if(TRKDEBUG)then              if(TRKVERBOSE)then
392                 PRINT*,' *** WARNING in mini ***  '                 PRINT*,' *** WARNING in mini ***  '
393                 PRINT*,'MINI_2 ==> AL(',I,') out of range'                 PRINT*,'MINI_2 ==> AL(',I,') out of range'
394                 PRINT*,'         value: ',AL(I),                 PRINT*,'         value: ',AL(I),
# Line 205  ',istep,' - ',al Line 401  ',istep,' - ',al
401              RETURN              RETURN
402           ENDIF           ENDIF
403        ENDDO              ENDDO      
404    *------------------------------------------------------------*
405  *     check number of steps:  *     check number of steps:
406        IF(ISTEP.gt.ISTEPMAX) then  *------------------------------------------------------------*
407           IFAIL=1        IF(ISTEP.ge.ISTEPMAX) then
408           if(TRKDEBUG)  c$$$         IFAIL=1
409       $        PRINT *,'*** WARNING in mini *** ISTEP.GT.ISTEPMAX=',  c$$$         if(TRKVERBOSE)
410       $        ISTEPMAX  c$$$     $        PRINT *,'*** WARNING in mini *** ISTEP.GT.ISTEPMAX=',
411    c$$$     $        ISTEPMAX
412           goto 11           goto 11
413        endif        endif
414    *------------------------------------------------------------*
415  *     ---------------------------------------------  *     ---------------------------------------------
416  *     evaluate deflection tolerance on the basis of  *     evaluate deflection tolerance on the basis of
417  *     estimated deflection  *     estimated deflection
418  *     ---------------------------------------------  *     ---------------------------------------------
419        ALTOL(5)=DSQRT(DELETA1**2+DELETA2**2*AL(5)**2)/FACT  *------------------------------------------------------------*
420    c$$$      ALTOL(5) = DSQRT(DELETA1**2+DELETA2**2*AL(5)**2)/FACT
421          ALTOL(5) = DSQRT((DELETA1*AVRESX)**2+DELETA2**2*AL(5)**2)/FACT
422          ALTOL(1) = ALTOL(5)/DELETA1
423          ALTOL(2) = ALTOL(1)
424          ALTOL(3) = DSQRT(ALTOL(1)**2+ALTOL(2)**2)/44.51
425          ALTOL(4) = ALTOL(3)        
426          
427    c$$$      print*,' -- ',(DAL(I),ALTOL(I),' - ',i=1,5) !>>>> new step!
428    
429  *---- check tolerances:  *---- check tolerances:
430    c$$$      DO I=1,5
431    c$$$         if(TRKVERBOSE)print*,i,' -- ',DAL(I),ALTOL(I) !>>>> new step!
432    c$$$      ENDDO
433    c$$$      print*,'chi2 -- ',DCHI2
434    
435          IF(ISTEP.LT.ISTEPMIN) GOTO 10 ! ***PP***
436        DO I=1,5        DO I=1,5
437           IF(ABS(DAL(I)).GT.ALTOL(I))GOTO 10 !>>>> new step!           IF(ABS(DAL(I)).GT.ALTOL(I))GOTO 10 !>>>> new step!
438        ENDDO        ENDDO
439    
440  *     new estimate of chi^2:  *****************************
441        JFAIL=0                   !error flag  *     final estimate of chi^2
442        CALL CHISQ(IFLAG,JFAIL)   !chi^2 and its derivatives  *****************************
443        IF(JFAIL.NE.0) THEN  
444           IFAIL=1  * -------------------------------
445           if(TRKDEBUG)THEN  * **** Chi2+gaussian minimization
446              CHI2=-9999.  * -------------------------------
447           if(TRKDEBUG)  
448       $        PRINT *,'*** ERROR in mini *** wrong CHISQ'        IF(.NOT.STUDENT) THEN
449           ENDIF  
450           RETURN           JFAIL=0                !error flag
451        ENDIF           CALL CHISQ(IFLAG,JFAIL) !chi^2 and its derivatives
452        COST=1e-7           IF(JFAIL.NE.0) THEN
       DO I=1,5  
          DO J=1,5  
             CHI2DD(I,J)=CHI2DD(I,J)*COST  
          ENDDO  
          CHI2D(I)=CHI2D(I)*COST  
       ENDDO        
       IF(PFIXED.EQ.0.) THEN  
          CALL DSFACT(5,CHI2DD,5,IFA,DET,JFA) !CHI2DD matrix determinant  
          IF(IFA.NE.0) THEN      !not positive-defined        
             if(TRKDEBUG)then  
                PRINT *,  
      $              '*** ERROR in mini ***'//  
      $              'on matrix inversion (not pos-def)'  
      $              ,DET  
             endif  
             IF(CHI2.EQ.0) CHI2=-9999.  
             IF(CHI2.GT.0) CHI2=-CHI2  
453              IFAIL=1              IFAIL=1
454              RETURN                          if(TRKVERBOSE)THEN
455                   CHI2=-9999.
456                   if(TRKVERBOSE)
457         $              PRINT *,'*** ERROR in mini *** wrong CHISQ'
458                ENDIF
459                RETURN
460           ENDIF           ENDIF
461           CALL DSFINV(5,CHI2DD,5) !CHI2DD matrix inversion      c      COST=1e-7
462           DO I=1,5                                         COST=1.
463              DAL(I)=0.                     DO I=1,5
464              DO J=1,5                          IF(CHI2DD(I,I).NE.0.)COST=COST/DABS(CHI2DD(I,I))**0.2
465                 COV(I,J)=2.*COST*CHI2DD(I,J)           ENDDO
466              ENDDO                         DO I=1,5
467           ENDDO                                DO J=1,5
468        ELSE                 CHI2DD(I,J)=CHI2DD(I,J)*COST
          DO I=1,4  
             CHI2D_R(I)=CHI2D(I)  
             DO J=1,4  
                CHI2DD_R(I,J)=CHI2DD(I,J)  
469              ENDDO              ENDDO
470           ENDDO           ENDDO
471           CALL DSFACT(4,CHI2DD_R,4,IFA,DET,JFA)           IF(PFIXED.EQ.0.) THEN
472           IF(IFA.NE.0) THEN              CALL DSFACT(5,CHI2DD,5,IFA,DET,JFA) !CHI2DD matrix determinant
473              if(TRKDEBUG)then              IF(IFA.NE.0) THEN   !not positive-defined      
474                 PRINT *,                 if(TRKVERBOSE)then
475       $              '*** ERROR in mini ***'//                    PRINT *,
476       $              'on matrix inversion (not pos-def)'       $                 '*** ERROR in mini ***'//
477       $              ,DET       $                 'on matrix inversion (not pos-def)'
478              endif       $                 ,DET
479              IF(CHI2.EQ.0) CHI2=-9999.                 endif
480              IF(CHI2.GT.0) CHI2=-CHI2                 IF(CHI2.EQ.0) CHI2=-9999.
481              IFAIL=1                 IF(CHI2.GT.0) CHI2=-CHI2
482              RETURN                             IFAIL=1
483                   RETURN            
484                ENDIF
485                CALL DSFINV(5,CHI2DD,5) !CHI2DD matrix inversion    
486                DO I=1,5                              
487    c$$$               DAL(I)=0.          
488                   DO J=1,5            
489                      COV(I,J)=2.*COST*CHI2DD(I,J)
490                   ENDDO              
491                ENDDO                  
492             ELSE
493                DO I=1,4
494                   CHI2D_R(I)=CHI2D(I)
495                   DO J=1,4
496                      CHI2DD_R(I,J)=CHI2DD(I,J)
497                   ENDDO
498                ENDDO
499                CALL DSFACT(4,CHI2DD_R,4,IFA,DET,JFA)
500                IF(IFA.NE.0) THEN
501                   if(TRKVERBOSE)then
502                      PRINT *,
503         $                 '*** ERROR in mini ***'//
504         $                 'on matrix inversion (not pos-def)'
505         $                 ,DET
506                   endif
507                   IF(CHI2.EQ.0) CHI2=-9999.
508                   IF(CHI2.GT.0) CHI2=-CHI2
509                   IFAIL=1
510                   RETURN            
511                ENDIF
512                CALL DSFINV(4,CHI2DD_R,4)
513                DO I=1,4
514    c$$$               DAL(I)=0.
515                   DO J=1,4
516                      COV(I,J)=2.*COST*CHI2DD_R(I,J)
517                   ENDDO
518                ENDDO
519           ENDIF           ENDIF
520           CALL DSFINV(4,CHI2DD_R,4)  
521           DO I=1,4        ENDIF
522              DAL(I)=0.  
523              DO J=1,4  * -------------------------------
524                 COV(I,J)=2.*COST*CHI2DD_R(I,J)  * **** Likelihood+student minimization
525    * -------------------------------
526    
527          IF(STUDENT) THEN
528             CALL CHISQSTT(1,JFAIL)
529             DO I=1,5
530                DO j=1,5
531                   COV(I,J) = 2.*CHI2DD(I,J)
532              ENDDO              ENDDO
533           ENDDO           ENDDO
534        ENDIF        ENDIF
535    
536  *****************************  *****************************
537    
538  *     ------------------------------------  *     ------------------------------------
# Line 306  ',istep,' - ',al Line 547  ',istep,' - ',al
547        if(pfixed.ne.0.) ndof=ndof-4 ! ***PP***        if(pfixed.ne.0.) ndof=ndof-4 ! ***PP***
548        if(ndof.le.0.) then        if(ndof.le.0.) then
549           ndof = 1           ndof = 1
550           if(TRKDEBUG)           if(TRKVERBOSE)
551       $        print*,'*** WARNING *** in mini n.dof = 0 (set to 1)'       $        print*,'*** WARNING *** in mini n.dof = 0 (set to 1)'
552        endif        endif
553    
554  *     ------------------------------------  *     ------------------------------------
555  *     Reduced chi^2  *     Reduced chi^2
556        CHI2 = CHI2/dble(ndof)        CHI2 = CHI2/dble(ndof)
557    
558    c      print*,'mini2: chi2 ',chi2
559    
560   11   CONTINUE         11   CONTINUE      
561    
562          if(TRKDEBUG) print*,'mini2: -ok- ',istep,chi2,1./AL(5)
563    
564        NSTEP=ISTEP ! ***PP***        NSTEP=ISTEP ! ***PP***
565    
566    c$$$      print*,'>>>>> NSTEP = ',NSTEP
567    
568        RETURN        RETURN
569        END                END        
570    
# Line 343  ',istep,' - ',al Line 591  ',istep,' - ',al
591       $     ,XV0(nplanes),YV0(nplanes)       $     ,XV0(nplanes),YV0(nplanes)
592        DIMENSION AL_P(5)        DIMENSION AL_P(5)
593    
594        LOGICAL TRKDEBUG  c      LOGICAL TRKVERBOSE
595        COMMON/TRKD/TRKDEBUG  c      COMMON/TRKD/TRKVERBOSE
596          LOGICAL TRKDEBUG,TRKVERBOSE
597          COMMON/TRKD/TRKDEBUG,TRKVERBOSE
598  *      *    
599  *     chi^2 computation  *     chi^2 computation
600  *      *    
# Line 354  ',istep,' - ',al Line 604  ',istep,' - ',al
604        JFAIL=0                   !error flag        JFAIL=0                   !error flag
605        CALL POSXYZ(AL_P,JFAIL)   !track intersection with tracking planes        CALL POSXYZ(AL_P,JFAIL)   !track intersection with tracking planes
606        IF(JFAIL.NE.0) THEN        IF(JFAIL.NE.0) THEN
607           IF(TRKDEBUG)           IF(TRKVERBOSE)
608       $        PRINT *,'CHISQ ==> error from trk routine POSXYZ !!'       $        PRINT *,'CHISQ ==> error from trk routine POSXYZ !!'
609           IFAIL=1           IFAIL=1
610           RETURN           RETURN
# Line 380  c$$$      ENDDO Line 630  c$$$      ENDDO
630  *     measured position of the cluster.  *     measured position of the cluster.
631  *     ---------------------------------------------------------  *     ---------------------------------------------------------
632        CHI2=0.        CHI2=0.
633        DO I=1,nplanes        DO I=1,nplanes        
634           IF(XGOOD(I).EQ.1.AND.YGOOD(I).EQ.0)THEN !X-cl           IF(XGOOD(I).EQ.1.AND.YGOOD(I).EQ.0)THEN !X-cl
635              BETA = (XM_B(I)-XM_A(I))/(YM_B(I)-YM_A(I))              BETA = (XM_B(I)-XM_A(I))/(YM_B(I)-YM_A(I))
636              ALFA = XM_A(I) - BETA * YM_A(I)              ALFA = XM_A(I) - BETA * YM_A(I)
# Line 407  c$$$      ENDDO Line 657  c$$$      ENDDO
657       +                                       *( XGOOD(I)*(1-YGOOD(I)) )       +                                       *( XGOOD(I)*(1-YGOOD(I)) )
658       +        +((XV(I)-XM(I))**2+(YV(I)-YM(I))**2)/RESY(i)**2       +        +((XV(I)-XM(I))**2+(YV(I)-YM(I))**2)/RESY(i)**2
659       +                                       *( (1-XGOOD(I))*YGOOD(I) )       +                                       *( (1-XGOOD(I))*YGOOD(I) )
660    c$$$         print*,(XV(I)-XM(I))**2/RESX(i)**2   *( XGOOD(I)*YGOOD(I) )
661    c$$$         print*,(YV(I)-YM(I))**2/RESY(i)**2   *( YGOOD(I)*XGOOD(I) )
662    c$$$         print*,((XV(I)-XM(I))**2+(YV(I)-YM(I))**2)/RESX(i)**2
663    c$$$     +        *( XGOOD(I)*(1-YGOOD(I)) )
664    c$$$         print*,((XV(I)-XM(I))**2+(YV(I)-YM(I))**2)/RESY(i)**2
665    c$$$     +        *( (1-XGOOD(I))*YGOOD(I) )
666    c$$$         print*,XV(I),XM(I),XGOOD(I)
667    c$$$         print*,YV(I),YM(I),YGOOD(I)
668        ENDDO        ENDDO
669    c$$$      print*,'CHISQ ',chi2
670  *     ------------------------------------------------  *     ------------------------------------------------
671  *      *    
672  *     calculation of derivatives (dX/dAL_fa and dY/dAL_fa)      *     calculation of derivatives (dX/dAL_fa and dY/dAL_fa)    
# Line 426  c$$$      ENDDO Line 685  c$$$      ENDDO
685              JFAIL=0              JFAIL=0
686              CALL POSXYZ(AL_P,JFAIL)              CALL POSXYZ(AL_P,JFAIL)
687              IF(JFAIL.NE.0) THEN              IF(JFAIL.NE.0) THEN
688                 IF(TRKDEBUG)                 IF(TRKVERBOSE)
689  *23456789012345678901234567890123456789012345678901234567890123456789012  *23456789012345678901234567890123456789012345678901234567890123456789012
690       $              PRINT *,'CHISQ ==> error from trk routine POSXYZ'       $              PRINT *,'CHISQ ==> error from trk routine POSXYZ'
691                 IFAIL=1                 IFAIL=1
# Line 440  c$$$      ENDDO Line 699  c$$$      ENDDO
699              JFAIL=0              JFAIL=0
700              CALL POSXYZ(AL_P,JFAIL)              CALL POSXYZ(AL_P,JFAIL)
701              IF(JFAIL.NE.0) THEN              IF(JFAIL.NE.0) THEN
702                 IF(TRKDEBUG)                 IF(TRKVERBOSE)
703       $              PRINT *,'CHISQ ==> error from trk routine POSXYZ'       $              PRINT *,'CHISQ ==> error from trk routine POSXYZ'
704                 IFAIL=1                 IFAIL=1
705                 RETURN                 RETURN
# Line 472  c$$$      ENDDO Line 731  c$$$      ENDDO
731                            
732              COSTHE=DSQRT(1.-AL(3)**2)              COSTHE=DSQRT(1.-AL(3)**2)
733              IF(COSTHE.EQ.0.) THEN              IF(COSTHE.EQ.0.) THEN
734                 IF(TRKDEBUG)PRINT *,'=== WARNING ===> COSTHE=0'                 IF(TRKVERBOSE)PRINT *,'=== WARNING ===> COSTHE=0'
735                 IFAIL=1                 IFAIL=1
736                 RETURN                 RETURN
737              ENDIF              ENDIF
# Line 527  c$$$      ENDDO Line 786  c$$$      ENDDO
786        RETURN        RETURN
787        END        END
788    
789    ******************************************************************************    
790    *    
791    *     routine to compute Likelihodd+Student and its derivatives
792    *    
793    *     (modified in respect to the previous one in order to include
794    *     single clusters. In this case the residual is evaluated by
795    *     calculating the distance between the track intersection and the
796    *     segment AB associated to the single cluster)
797    *
798    ******************************************************************************
799    
800          SUBROUTINE CHISQSTT(IFLAG,JFAIL)
801    
802          IMPLICIT DOUBLE PRECISION (A-H,O-Z)
803    
804          include 'commontracker.f' !tracker general common
805          include 'common_mini_2.f' !common for the tracking procedure
806    
807          LOGICAL TRKDEBUG,TRKVERBOSE
808          COMMON/TRKD/TRKDEBUG,TRKVERBOSE
809    
810          DIMENSION AL_P(5)
811          DIMENSION VECTEMP(5)
812    c$$$      DIMENSION U(5) ! BFGS
813    
814          DO I=1,5
815             AL_P(I)=AL(I)
816          ENDDO
817          JFAIL=0                   !error flag
818          CALL POSXYZ(AL_P,JFAIL)   !track intersection with tracking planes
819          IF(JFAIL.NE.0) THEN
820             IF(TRKVERBOSE)
821         $        PRINT *,'CHISQSTT ==> error from trk routine POSXYZ !!'
822             IFAIL=1
823             RETURN
824          ENDIF
825    
826          DO I=1,nplanes
827             DXDAL(I,1)=1.
828             DYDAL(I,1)=0.
829             DXDAL(I,2)=0.
830             DYDAL(I,2)=1.
831             COSTHE=DSQRT(1.-AL(3)**2)
832             IF(COSTHE.EQ.0.) THEN
833                IF(TRKVERBOSE)PRINT *,'=== WARNING ===> COSTHE=0'
834                IFAIL=1
835                RETURN
836             ENDIF
837             DXDAL(I,3)=(ZINI-ZM(I))*DCOS(AL(4))/COSTHE**3
838             DYDAL(I,3)=(ZINI-ZM(I))*DSIN(AL(4))/COSTHE**3
839             DXDAL(I,4)=-AL(3)*(ZINI-ZM(I))*DSIN(AL(4))/COSTHE
840             DYDAL(I,4)=AL(3)*(ZINI-ZM(I))*DCOS(AL(4))/COSTHE
841             IF(AL(5).NE.0.) THEN      
842                DXDAL(I,5)=
843         +           (XV(I)-(AL(1)+AL(3)/COSTHE*(ZINI-ZM(I))
844         +           *DCOS(AL(4))))/AL(5)
845                DYDAL(I,5)=
846         +           (YV(I)-(AL(2)+AL(3)/COSTHE*(ZINI-ZM(I))
847         +           *DSIN(AL(4))))/AL(5)
848             ELSE
849                DXDAL(I,5)=100.*( 0.25 *0.3*0.4*(0.01*(ZINI-ZM(I)))**2 )
850                DYDAL(I,5)=0.
851             ENDIF
852          ENDDO
853    
854          IF(IFLAG.EQ.0) THEN ! function calulation
855             CHI2=0.
856             DO I=1,nplanes
857                IF(XGOOD(I).EQ.1.AND.YGOOD(I).EQ.0)THEN !X-cl
858                   BETA = (XM_B(I)-XM_A(I))/(YM_B(I)-YM_A(I))
859                   ALFA = XM_A(I) - BETA * YM_A(I)
860                   YM(I) = ( YV(I) + BETA*XV(I) - BETA*ALFA )/(1+BETA**2)
861                   if(YM(I).lt.dmin1(YM_A(I),YM_B(I)))
862         $              YM(I)=dmin1(YM_A(I),YM_B(I))
863                   if(YM(I).gt.dmax1(YM_A(I),YM_B(I)))
864         $              YM(I)=dmax1(YM_A(I),YM_B(I))
865                   XM(I) = ALFA + BETA * YM(I) !<<<< measured coordinates
866                ELSEIF(XGOOD(I).EQ.0.AND.YGOOD(I).EQ.1)THEN !Y-cl
867                   BETA = (YM_B(I)-YM_A(I))/(XM_B(I)-XM_A(I))
868                   ALFA = YM_A(I) - BETA * XM_A(I)
869                   XM(I) = ( XV(I) + BETA*YV(I) - BETA*ALFA )/(1+BETA**2)
870                   if(XM(I).lt.dmin1(XM_A(I),XM_B(I)))
871         $              XM(I)=dmin1(XM_A(I),XM_B(I))
872                   if(XM(I).gt.dmax1(XM_A(I),XM_B(I)))
873         $              XM(I)=dmax1(XM_A(I),XM_B(I))
874                   YM(I) = ALFA + BETA * XM(I) !<<<< measured coordinates
875                ENDIF
876                TERMX = DLOG( (TAILX(I)*RESX(I)**2+(XV(I)-XM(I))**2)/
877         $           (TAILX(I)*RESX(I)**2) )
878                TERMY = DLOG( (TAILY(I)*RESY(I)**2+(YV(I)-YM(I))**2)/
879         $           (TAILY(I)*RESY(I)**2) )
880                CHI2=CHI2
881         $           +(TAILX(I)+1.0)*TERMX   *( XGOOD(I) )
882         $           +(TAILY(I)+1.0)*TERMY   *( YGOOD(I) )
883             ENDDO
884          ENDIF
885    
886          IF(IFLAG.EQ.1) THEN ! derivative calulation
887             DO I=1,5
888                CHI2DOLD(I)=CHI2D(I)
889             ENDDO
890             DO J=1,5
891                CHI2D(J)=0.      
892                DO I=1,nplanes
893                   CHI2D(J)=CHI2D(J)
894         $              +2.*(TAILX(I)+1.0)*(XV(I)-XM(I))/
895         $              (TAILX(I)*RESX(I)**2+(XV(I)-XM(I))**2)*
896         $              DXDAL(I,J)   *XGOOD(I)
897         $              +2.*(TAILY(I)+1.0)*(YV(I)-YM(I))/
898         $              (TAILY(I)*RESY(I)**2+(YV(I)-YM(I))**2)*
899         $              DYDAL(I,J)   *YGOOD(I)
900                ENDDO
901             ENDDO
902             DO K=1,5
903                VECTEMP(K)=0.
904                DO M=1,5
905                   VECTEMP(K) = VECTEMP(K) +
906         $              COV(K,M)/2.*(CHI2D(M)-CHI2DOLD(M))
907                ENDDO
908             ENDDO
909             DOWN1 = 0.
910             DO K=1,5
911                DOWN1 = DOWN1 + DAL(K)*(CHI2D(K)-CHI2DOLD(K))
912             ENDDO
913             IF(DOWN1.EQ.0.) THEN
914                PRINT*,'WARNING IN MATRIX CALULATION (STUDENT), DOWN1 = 0'
915                IFAIL=1
916                RETURN
917             ENDIF
918             DOWN2 = 0.
919             DO K=1,5
920                DO M=1,5
921                   DOWN2 = DOWN2 + (CHI2D(K)-CHI2DOLD(K))*VECTEMP(K)
922                ENDDO
923             ENDDO
924             IF(DOWN2.EQ.0.) THEN
925                PRINT*,'WARNING IN MATRIX CALULATION (STUDENT), DOWN2 = 0'
926                IFAIL=1
927                RETURN
928             ENDIF
929    c$$$         DO K=1,5 ! BFGS
930    c$$$            U(K) = DAL(K)/DOWN1 - VECTEMP(K)/DOWN2
931    c$$$         ENDDO
932             DO I=1,5
933                DO J=1,5
934                   CHI2DD(I,J) = COV(I,J)/2.
935         $              +DAL(I)*DAL(J)/DOWN1
936         $              -VECTEMP(I)*VECTEMP(J)/DOWN2
937    c$$$     $              +DOWN2*U(I)*U(J) ! BFGS
938                ENDDO
939             ENDDO
940          ENDIF
941    
942          RETURN
943          END
944          
945  *****************************************************************  *****************************************************************
946  *  *
947  *     Routine to compute the track intersection points  *     Routine to compute the track intersection points
# Line 559  c$$$      ENDDO Line 973  c$$$      ENDDO
973        include 'commontracker.f' !tracker general common        include 'commontracker.f' !tracker general common
974        include 'common_mini_2.f' !common for the tracking procedure        include 'common_mini_2.f' !common for the tracking procedure
975    
976        LOGICAL TRKDEBUG  c      LOGICAL TRKVERBOSE
977        COMMON/TRKD/TRKDEBUG  c      COMMON/TRKD/TRKVERBOSE
978          LOGICAL TRKDEBUG,TRKVERBOSE
979          COMMON/TRKD/TRKDEBUG,TRKVERBOSE
980  c        c      
981        DIMENSION AL_P(5)        DIMENSION AL_P(5)
982  *      *    
983        DO I=1,nplanes  cpp      DO I=1,nplanes
984           ZV(I)=ZM(I)            !  cpp         ZV(I)=ZM(I)            !
985        ENDDO        cpp      ENDDO      
986  *      *    
987  *     set parameters for GRKUTA  *     set parameters for GRKUTA
988  *      *    
# Line 580  c       Line 996  c      
996        VOUT(6)=-1.*DSQRT(1.-AL_P(3)**2)        VOUT(6)=-1.*DSQRT(1.-AL_P(3)**2)
997        IF(AL_P(5).NE.0.) VOUT(7)=DABS(1./AL_P(5))        IF(AL_P(5).NE.0.) VOUT(7)=DABS(1./AL_P(5))
998        IF(AL_P(5).EQ.0.) VOUT(7)=1.E8        IF(AL_P(5).EQ.0.) VOUT(7)=1.E8
999    
1000    c$$$      print*,'POSXY (prima) ',vout
1001    
1002        DO I=1,nplanes        DO I=1,nplanes
1003           step=vout(3)-zv(i)  c$$$         ipass = 0 ! TEST
1004    c$$$         PRINT *,'TRACKING -> START PLANE: ',I ! TEST
1005    cPPP         step=vout(3)-zm(i)
1006    cPP         step=(zm(i)-vout(3))/VOUT(6)
1007   10      DO J=1,7   10      DO J=1,7
1008              VECT(J)=VOUT(J)              VECT(J)=VOUT(J)
1009              VECTINI(J)=VOUT(J)              VECTINI(J)=VOUT(J)
1010           ENDDO           ENDDO
1011    cPPP         step=vect(3)-zm(i)
1012             IF(VOUT(6).GE.0.) THEN
1013                IFAIL=1
1014                if(TRKVERBOSE)      
1015         $           PRINT *,'posxy (grkuta): WARNING ===> backward track!!'
1016                RETURN
1017             ENDIF
1018             step=(zm(i)-vect(3))/VOUT(6)
1019   11      continue   11      continue
1020           CALL GRKUTA(CHARGE,STEP,VECT,VOUT)           CALL GRKUTA(CHARGE,STEP,VECT,VOUT)
1021    c$$$         ipass = ipass + 1 ! TEST
1022    c$$$         PRINT *,'TRACKING -> STEP: ',ipass,' LENGHT: ', STEP ! TEST
1023           IF(VOUT(3).GT.VECT(3)) THEN           IF(VOUT(3).GT.VECT(3)) THEN
1024              IFAIL=1              IFAIL=1
1025              if(TRKDEBUG)              if(TRKVERBOSE)
1026       $      PRINT *,'posxy (grkuta): WARNING ===> backward track!!'       $      PRINT *,'posxy (grkuta): WARNING ===> backward track!!'
1027              if(.TRUE.)print*,'charge',charge  c$$$            if(.TRUE.)print*,'charge',charge
1028              if(.TRUE.)print*,'vect',vect  c$$$            if(.TRUE.)print*,'vect',vect
1029              if(.TRUE.)print*,'vout',vout  c$$$            if(.TRUE.)print*,'vout',vout
1030              if(.TRUE.)print*,'step',step  c$$$            if(.TRUE.)print*,'step',step
1031                if(TRKVERBOSE)print*,'charge',charge
1032                if(TRKVERBOSE)print*,'vect',vect
1033                if(TRKVERBOSE)print*,'vout',vout
1034                if(TRKVERBOSE)print*,'step',step
1035              RETURN              RETURN
1036           ENDIF           ENDIF
1037           Z=VOUT(3)           Z=VOUT(3)
# Line 609  c       Line 1045  c      
1045              GOTO 11              GOTO 11
1046           ENDIF           ENDIF
1047    
1048    
1049  *     -----------------------------------------------  *     -----------------------------------------------
1050  *        evaluate track coordinates  *        evaluate track coordinates
1051   100     XV(I)=VOUT(1)   100     XV(I)=VOUT(1)
# Line 618  c       Line 1055  c      
1055           AYV(I)=DATAN(VOUT(5)/VOUT(6))*180./ACOS(-1.)           AYV(I)=DATAN(VOUT(5)/VOUT(6))*180./ACOS(-1.)
1056  *     -----------------------------------------------  *     -----------------------------------------------
1057    
1058             IF(TRACKMODE.EQ.1) THEN
1059    *     -----------------------------------------------
1060    *        change of energy by bremsstrahlung for electrons
1061                VOUT(7) = VOUT(7) * 0.997 !0.9968
1062    *     -----------------------------------------------
1063             ENDIF
1064    c$$$         PRINT *,'TRACKING -> END' ! TEST
1065    
1066        ENDDO        ENDDO
1067    
1068    c$$$      print*,'POSXY (dopo) ',vout
1069    
1070    
1071        RETURN        RETURN
1072        END        END
1073    
# Line 652  c       Line 1100  c      
1100           YM(IP) = -100.         !0.           YM(IP) = -100.         !0.
1101           XM_A(IP) = -100.         !0.           XM_A(IP) = -100.         !0.
1102           YM_A(IP) = -100.         !0.           YM_A(IP) = -100.         !0.
1103  c         ZM_A(IP) = 0           ZM_A(IP) = fitz(nplanes-ip+1) !init to mech. position
1104           XM_B(IP) =  -100.         !0.           XM_B(IP) =  -100.         !0.
1105           YM_B(IP) =  -100.         !0.           YM_B(IP) =  -100.         !0.
1106  c         ZM_B(IP) = 0           ZM_B(IP) = fitz(nplanes-ip+1) !init to mech. position
1107           RESX(IP) = 1000.       !3.d-4           RESX(IP) = 1000.       !3.d-4
1108           RESY(IP) = 1000.       !12.d-4           RESY(IP) = 1000.       !12.d-4
1109           XGOOD(IP) = 0           XGOOD(IP) = 0
1110           YGOOD(IP) = 0           YGOOD(IP) = 0
1111             DEDXTRK_X(IP) = 0
1112             DEDXTRK_Y(IP) = 0
1113             AXV(IP) = 0
1114             AYV(IP) = 0
1115             XV(IP) = -100
1116             YV(IP) = -100
1117        enddo        enddo
1118    
1119        return        return
1120        end        end
1121    
1122    
1123    ***************************************************
1124    *                                                 *
1125    *                                                 *
1126    *                                                 *
1127    *                                                 *
1128    *                                                 *
1129    *                                                 *
1130    **************************************************
1131    
1132          subroutine guess()
1133    
1134    c      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
1135    
1136          include 'commontracker.f' !tracker general common
1137          include 'common_mini_2.f' !common for the tracking procedure
1138          
1139          REAL*4 XP(NPLANES),ZP(NPLANES),AP(NPLANES),RP(NPLANES)
1140          REAL*4 CHI,XC,ZC,RADIUS
1141    *     ----------------------------------------
1142    *     Y view
1143    *     ----------------------------------------
1144    *     ----------------------------------------
1145    *     initial guess with a straigth line
1146    *     ----------------------------------------
1147          SZZ=0.                    
1148          SZY=0.
1149          SSY=0.
1150          SZ=0.
1151          S1=0.
1152          DO I=1,nplanes
1153             IF(YGOOD(I).EQ.1)THEN
1154                YY = YM(I)
1155                IF(XGOOD(I).EQ.0)THEN
1156                   YY = (YM_A(I) + YM_B(I))/2
1157                ENDIF
1158                SZZ=SZZ+ZM(I)*ZM(I)
1159                SZY=SZY+ZM(I)*YY
1160                SSY=SSY+YY
1161                SZ=SZ+ZM(I)
1162                S1=S1+1.
1163             ENDIF
1164          ENDDO
1165          DET=SZZ*S1-SZ*SZ
1166          AY=(SZY*S1-SZ*SSY)/DET
1167          BY=(SZZ*SSY-SZY*SZ)/DET
1168          Y0 = AY*ZINI+BY
1169    *     ----------------------------------------
1170    *     X view
1171    *     ----------------------------------------
1172    *     ----------------------------------------
1173    *     1) initial guess with a circle
1174    *     ----------------------------------------
1175          NP=0
1176          DO I=1,nplanes
1177             IF(XGOOD(I).EQ.1)THEN
1178                XX = XM(I)
1179                IF(YGOOD(I).EQ.0)THEN
1180                   XX = (XM_A(I) + XM_B(I))/2
1181                ENDIF
1182                NP=NP+1
1183                XP(NP)=XX
1184                ZP(NP)=ZM(I)
1185             ENDIF
1186          ENDDO
1187          IFLAG=0                   !no debug mode
1188          CALL TRICIRCLE(NP,XP,ZP,AP,RP,CHI,XC,ZC,RADIUS,IFLAG)
1189    
1190    c$$$      print*,' circle: ',XC,ZC,RADIUS,' --- ',CHI,IFLAG
1191    c$$$      print*,' XP ',(xp(i),i=1,np)
1192    c$$$      print*,' ZP ',(zp(i),i=1,np)
1193    c$$$      print*,' AP ',(ap(i),i=1,np)
1194    c$$$      print*,' XP ',(rp(i),i=1,np)
1195    
1196          IF(IFLAG.NE.0)GOTO 10 !straigth fit
1197    c      if(CHI.gt.100)GOTO 10 !straigth fit
1198          ARG = RADIUS**2-(ZINI-ZC)**2
1199          IF(ARG.LT.0)GOTO 10       !straigth fit
1200          DC = SQRT(ARG)      
1201          IF(XC.GT.0)DC=-DC
1202          X0=XC+DC
1203          AX = -(ZINI-ZC)/DC
1204          DEF=100./(RADIUS*0.3*0.43)
1205          IF(XC.GT.0)DEF=-DEF
1206          
1207    
1208    
1209          IF(ABS(X0).GT.30)THEN
1210    c$$$         PRINT*,'STRANGE GUESS: XC,ZC,R ',XC,ZC,RADIUS
1211    c$$$     $     ,' - CHI ',CHI,' - X0,AX,DEF ',X0,AX,DEF
1212             GOTO 10       !straigth fit
1213          ENDIF
1214          GOTO 20                   !guess is ok
1215    
1216    *     ----------------------------------------
1217    *     2) initial guess with a straigth line
1218    *     - if circle does not intersect reference plane
1219    *     - if bad chi**2
1220    *     ----------------------------------------
1221     10   CONTINUE
1222          SZZ=0.                  
1223          SZX=0.
1224          SSX=0.
1225          SZ=0.
1226          S1=0.
1227          DO I=1,nplanes
1228             IF(XGOOD(I).EQ.1)THEN
1229                XX = XM(I)
1230                IF(YGOOD(I).EQ.0)THEN
1231                   XX = (XM_A(I) + XM_B(I))/2
1232                ENDIF
1233                SZZ=SZZ+ZM(I)*ZM(I)
1234                SZX=SZX+ZM(I)*XX
1235                SSX=SSX+XX
1236                SZ=SZ+ZM(I)
1237                S1=S1+1.
1238             ENDIF
1239          ENDDO
1240          DET=SZZ*S1-SZ*SZ
1241          AX=(SZX*S1-SZ*SSX)/DET
1242          BX=(SZZ*SSX-SZX*SZ)/DET
1243          DEF = 0
1244          X0  = AX*ZINI+BX
1245    
1246     20   CONTINUE
1247    *     ----------------------------------------
1248    *     guess
1249    *     ----------------------------------------
1250    
1251          AL(1) = X0
1252          AL(2) = Y0
1253          tath  = sqrt(AY**2+AX**2)
1254          AL(3) = tath/sqrt(1+tath**2)
1255    c$$$      IF(AX.NE.0)THEN
1256    c$$$         AL(4)= atan(AY/AX)
1257    c$$$      ELSE
1258    c$$$         AL(4) = acos(-1.)/2
1259    c$$$         IF(AY.LT.0)AL(4) = AL(4)+acos(-1.)
1260    c$$$  ENDIF
1261    c$$$      IF(AX.LT.0)AL(4)= acos(-1.)+ AL(4)
1262    c$$$      AL(4) = -acos(-1.) + AL(4) !from incidence direction to tracking ref.sys.
1263    
1264    c$$$      AL(4) =  0.
1265    c$$$      IF(AX.NE.0.AND.AY.NE.0)THEN
1266    c$$$         AL(4)= atan(AY/AX)
1267    c$$$      ELSEIF(AY.EQ.0)THEN
1268    c$$$         AL(4) = 0.
1269    c$$$         IF(AX.LT.0)AL(4) = AL(4)+acos(-1.)        
1270    c$$$      ELSEIF(AX.EQ.0)THEN
1271    c$$$         AL(4) = acos(-1.)/2
1272    c$$$         IF(AY.LT.0)AL(4) = AL(4)+acos(-1.)
1273    c$$$      ENDIF
1274    c$$$      IF(AX.LT.0)AL(4)= acos(-1.)+ AL(4)
1275    c$$$      AL(4) = -acos(-1.) + AL(4) !from incidence direction to tracking ref.sys.
1276    
1277    c$$$      AL(4)=0.
1278    c$$$      IF( AX.NE.0.OR.AY.NE.0. ) THEN
1279    c$$$         AL(4) = ASIN(AY/SQRT(AX**2+AY**2))
1280    c$$$         IF(AX.LT.0.) AL(4) = ACOS(-1.0)-AL(4)
1281    c$$$      ENDIF
1282    
1283          AL(4)=0.
1284          IF( AX.NE.0.OR.AY.NE.0. ) THEN
1285             AL(4) = ASIN(AY/SQRT(AX**2+AY**2))
1286             IF(AX.LT.0.AND.AY.GE.0) AL(4) = ACOS(-1.0)-AL(4)
1287             IF(AX.LT.0.AND.AY.LT.0) AL(4) = -ACOS(-1.0)-AL(4)
1288          ENDIF
1289          IF(AY.GT.0.) AL(4) = AL(4)-ACOS(-1.0)
1290          IF(AY.LE.0.) AL(4) = AL(4)+ACOS(-1.0)
1291    
1292          AL(5) = DEF
1293    
1294    c      print*,' guess: ',(al(i),i=1,5)
1295    
1296          end

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.21

  ViewVC Help
Powered by ViewVC 1.1.23