/[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.13 by pam-fi, Mon Feb 19 16:28:39 2007 UTC revision 1.24 by pam-fi, Tue Dec 23 11:28:36 2008 UTC
# Line 46  c      DATA ALMIN/-dinf,-dinf,-1.,-dinf, Line 46  c      DATA ALMIN/-dinf,-dinf,-1.,-dinf,
46        DATA ALMAX/dinf,dinf,1.,dinf,dinf/ !limits on alpha vector components        DATA ALMAX/dinf,dinf,1.,dinf,dinf/ !limits on alpha vector components
47        DATA ALMIN/-dinf,-dinf,-1.,-dinf,-dinf/ !"        DATA ALMIN/-dinf,-dinf,-1.,-dinf,-dinf/ !"
48    
49        DIMENSION DAL(5)                    !increment of vector alfa  c$$$      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--------  c     elena--------
# Line 67  c--------------------------------------- Line 67  c---------------------------------------
67                    
68  c      LOGICAL TRKDEBUG,TRKVERBOSE  c      LOGICAL TRKDEBUG,TRKVERBOSE
69  c      COMMON/TRKD/TRKDEBUG,TRKVERBOSE  c      COMMON/TRKD/TRKDEBUG,TRKVERBOSE
70        LOGICAL TRKDEBUG,TRKVERBOSE        LOGICAL TRKDEBUG,TRKVERBOSE,STUDENT,FIRSTSTEPS,FIRSTSTUDENT
71        COMMON/TRKD/TRKDEBUG,TRKVERBOSE        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           TRKVERBOSE = .TRUE.           TRKVERBOSE = .TRUE.
90           TRKDEBUG   = .FALSE.           TRKDEBUG   = .FALSE.
# Line 86  c      COMMON/TRKD/TRKDEBUG,TRKVERBOSE Line 101  c      COMMON/TRKD/TRKDEBUG,TRKVERBOSE
101  *     ----------------------------------------------------------  *     ----------------------------------------------------------
102        AVRESX = RESXAV        AVRESX = RESXAV
103        AVRESY = RESYAV        AVRESY = RESYAV
104          NX = 0.0
105          NY = 0.0
106        DO IP=1,6        DO IP=1,6
107           IF( XGOOD(IP).EQ.1 )THEN           IF( XGOOD(IP).EQ.1 )THEN
108              NX=NX+1              NX=NX+1.0
109              AVRESX=AVRESX+RESX(IP)              AVRESX=AVRESX+RESX(IP)
110           ENDIF           ENDIF
          IF(NX.NE.0)AVRESX=AVRESX/NX  
111           IF( YGOOD(IP).EQ.1 )THEN           IF( YGOOD(IP).EQ.1 )THEN
112              NY=NY+1              NY=NY+1.0
113              AVRESY=AVRESY+RESY(IP)              AVRESY=AVRESY+RESY(IP)
114           ENDIF           ENDIF
          IF(NX.NE.0)AVRESY=AVRESY/NY          
115        ENDDO        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
# Line 105  c      COMMON/TRKD/TRKDEBUG,TRKVERBOSE Line 122  c      COMMON/TRKD/TRKDEBUG,TRKVERBOSE
122  *     ----------------------------------------------------------  *     ----------------------------------------------------------
123  *     changed in order to evaluate energy-dependent  *     changed in order to evaluate energy-dependent
124  *     tolerances on all 5 parameters  *     tolerances on all 5 parameters
125        FACT=100.                  !scale factor to define tolerance on alfa  cPP      FACT=1.0e10                  !scale factor to define tolerance on alfa
126  c     deflection error (see PDG)  c     deflection error (see PDG)
127        DELETA1 = 0.01/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)
# Line 124  c$$$      DELETA2 = 0.016/0.3/0.4/0.4451 Line 141  c$$$      DELETA2 = 0.016/0.3/0.4/0.4451
141        CHI2=0        CHI2=0
142    
143        if(TRKDEBUG) print*,'guess: ',al        if(TRKDEBUG) print*,'guess: ',al
144        if(TRKDEBUG) print*,'mini2: step ',istep,chi2,1./AL(5)        if(TRKDEBUG) print*,'mini2: step ',istep,chi2,AL(5)
145    
146  *      *    
147  *     -----------------------  *     -----------------------
# Line 132  c$$$      DELETA2 = 0.016/0.3/0.4/0.4451 Line 149  c$$$      DELETA2 = 0.016/0.3/0.4/0.4451
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  * -------------------------------
155           CHI2=-9999.  
156           if(TRKVERBOSE)        IF((.NOT.STUDENT).OR.FIRSTSTEPS) THEN
157       $        PRINT *,'*** ERROR in mini *** wrong CHISQ'  
158           RETURN           IF(ISTEP.GE.3) FIRSTSTEPS = .false.
159        ENDIF  
160                   CALL CHISQ(IFLAG,JFAIL) !chi^2 and its derivatives
161        COST=1e-5           IF(JFAIL.NE.0) THEN
162        DO I=1,5              IFAIL=1
163           DO J=1,5              CHI2=-9999.
164              CHI2DD(I,J)=CHI2DD(I,J)*COST              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(TRKVERBOSE)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                  *     find new value of AL-pha                
202  *     *******************************************                                          *     *******************************************                                        
203           DO I=1,5                                            DO I=1,5                              
204              DAL(I)=0.                           DAL(I)=0.          
205              DO J=1,5                             DO J=1,5            
206                 DAL(I)=DAL(I)-CHI2DD(I,J)*CHI2D(J)                    DAL(I)=DAL(I)-CHI2DD(I,J)*CHI2D(J)  *COST
207                 COV(I,J)=2.*COST*CHI2DD(I,J)                    COV(I,J)=2.*COST*CHI2DD(I,J)
208              ENDDO                               ENDDO  
209           ENDDO                                ENDDO                  
210           DO I=1,5                            DO I=1,5              
211              AL(I)=AL(I)+DAL(I)                   AL(I)=AL(I)+DAL(I)  
212           ENDDO                                ENDDO                  
213  *------------------------------------------------------------*  *------------------------------------------------------------*
214  *     track fitting with FIXED deflection  *     track fitting with FIXED deflection
215  *------------------------------------------------------------*  *------------------------------------------------------------*
216        ELSE           ELSE
217           AL(5)=1./PFIXED              AL(5)=1./PFIXED
218           DO I=1,4              DO I=1,4
219              CHI2D_R(I)=CHI2D(I)                 CHI2D_R(I)=CHI2D(I)
220              DO J=1,4                 DO J=1,4
221                 CHI2DD_R(I,J)=CHI2DD(I,J)                    CHI2DD_R(I,J)=CHI2DD(I,J)
222                   ENDDO
223              ENDDO              ENDDO
224           ENDDO              CALL DSFACT(4,CHI2DD_R,4,IFA,DET,JFA)
225           CALL DSFACT(4,CHI2DD_R,4,IFA,DET,JFA)              IF(IFA.NE.0) THEN
226           IF(IFA.NE.0) THEN                 if(TRKVERBOSE)then
227              if(TRKVERBOSE)then                    PRINT *,
228                 PRINT *,       $                 '*** ERROR in mini ***'//
229       $              '*** ERROR in mini ***'//       $                 'on matrix inversion (not pos-def)'
230       $              'on matrix inversion (not pos-def)'       $                 ,DET
231       $              ,DET                 endif
232              endif                 IF(CHI2.EQ.0) CHI2=-9999.
233              IF(CHI2.EQ.0) CHI2=-9999.                 IF(CHI2.GT.0) CHI2=-CHI2
234              IF(CHI2.GT.0) CHI2=-CHI2                 IFAIL=1
235              IFAIL=1                 RETURN            
236              RETURN                          ENDIF
237           ENDIF              CALL DSFINV(4,CHI2DD_R,4)
          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              DO I=1,4
242              DAL(I)=0.                 DAL(I)=0.
243              DO J=1,4                 DO J=1,4
244                 DAL(I)=DAL(I)-CHI2DD_R(I,J)*CHI2D_R(J)                    DAL(I)=DAL(I)-CHI2DD_R(I,J)*CHI2D_R(J)  *COST
245                 COV(I,J)=2.*COST*CHI2DD_R(I,J)                    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,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                              
275                DAL(I)=0.          
276                DO J=1,5            
277                   DAL(I)=DAL(I)-CHI2DD(I,J)*CHI2D(J)
278                ENDDO  
279             ENDDO                  
280            
281             DO I=1,5
282                DO j=1,5
283                   COV(I,J) = 2.*CHI2DD(I,J)
284              ENDDO              ENDDO
285           ENDDO           ENDDO
286           DAL(5)=0.          
287           DO I=1,4           CHI2TOLL = 1.E-3
288              AL(I)=AL(I)+DAL(I)           ALPHA = 3.0
289             BETA = -0.4
290             E=1.
291             EA=1.
292             EB=1.
293             EC=1.
294             FA=1.
295             FB=1.
296             FC=1.
297             SUCCESS_OLD = .FALSE.
298             SUCCESS_NEW = .FALSE.
299    
300             CALL CHISQSTT(0,JFAIL)
301    c$$$         PRINT*,CHI2
302             CHI2_NEW = CHI2
303             FC = CHI2
304             EC = 0.
305    
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             DO I=1,5
314                AL(I)=AL(I)+E*DAL(I)
315             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
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        if(TRKDEBUG) print*,'mini2: step ',istep,chi2,1./AL(5)          
381    
382    
383    
384  *------------------------------------------------------------*  *------------------------------------------------------------*
385  *     ----------------------------------------------------   *  *     ----------------------------------------------------   *
# Line 261  c$$$     $        ISTEPMAX Line 418  c$$$     $        ISTEPMAX
418  *     ---------------------------------------------  *     ---------------------------------------------
419  *------------------------------------------------------------*  *------------------------------------------------------------*
420  c$$$      ALTOL(5) = DSQRT(DELETA1**2+DELETA2**2*AL(5)**2)/FACT  c$$$      ALTOL(5) = DSQRT(DELETA1**2+DELETA2**2*AL(5)**2)/FACT
421          IF(FACT.EQ.0)THEN
422             IFAIL=1
423             RETURN
424          ENDIF
425        ALTOL(5) = DSQRT((DELETA1*AVRESX)**2+DELETA2**2*AL(5)**2)/FACT        ALTOL(5) = DSQRT((DELETA1*AVRESX)**2+DELETA2**2*AL(5)**2)/FACT
426        ALTOL(1) = ALTOL(5)/DELETA1        ALTOL(1) = ALTOL(5)/DELETA1
427        ALTOL(2) = ALTOL(1)        ALTOL(2) = ALTOL(1)
428        ALTOL(3) = DSQRT(ALTOL(1)**2+ALTOL(2)**2)/44.51        ALTOL(3) = DSQRT(ALTOL(1)**2+ALTOL(2)**2)/44.51
429        ALTOL(4) = ALTOL(3)                ALTOL(4) = ALTOL(3)        
430                
431    c$$$      print*,' -- ',(DAL(I),ALTOL(I),' - ',i=1,5) !>>>> new step!
432    
433  *---- check tolerances:  *---- check tolerances:
434  c$$$      DO I=1,5  c$$$      DO I=1,5
435  c$$$         if(TRKVERBOSE)print*,i,' -- ',DAL(I),ALTOL(I) !>>>> new step!  c$$$         if(TRKVERBOSE)print*,i,' -- ',DAL(I),ALTOL(I) !>>>> new step!
436  c$$$      ENDDO  c$$$      ENDDO
437  c$$$      print*,'chi2 -- ',DCHI2  c$$$      print*,'chi2 -- ',DCHI2
438    
439        IF(ISTEP.LT.3) GOTO 10 ! ***PP***        IF(ISTEP.LT.ISTEPMIN) GOTO 10 ! ***PP***
440        DO I=1,5        DO I=1,5
441           IF(ABS(DAL(I)).GT.ALTOL(I))GOTO 10 !>>>> new step!           IF(ABS(DAL(I)).GT.ALTOL(I))GOTO 10 !>>>> new step!
442        ENDDO        ENDDO
443    
444  *     new estimate of chi^2:  *****************************
445        JFAIL=0                   !error flag  *     final estimate of chi^2
446        CALL CHISQ(IFLAG,JFAIL)   !chi^2 and its derivatives  *****************************
447        IF(JFAIL.NE.0) THEN  
448           IFAIL=1  * -------------------------------
449           if(TRKVERBOSE)THEN  * **** Chi2+gaussian minimization
450              CHI2=-9999.  * -------------------------------
451           if(TRKVERBOSE)  
452       $        PRINT *,'*** ERROR in mini *** wrong CHISQ'        IF(.NOT.STUDENT) THEN
453           ENDIF  
454           RETURN           JFAIL=0                !error flag
455        ENDIF           CALL CHISQ(IFLAG,JFAIL) !chi^2 and its derivatives
456        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(TRKVERBOSE)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  
457              IFAIL=1              IFAIL=1
458              RETURN                          if(TRKVERBOSE)THEN
459                   CHI2=-9999.
460                   if(TRKVERBOSE)
461         $              PRINT *,'*** ERROR in mini *** wrong CHISQ'
462                ENDIF
463                RETURN
464           ENDIF           ENDIF
465           CALL DSFINV(5,CHI2DD,5) !CHI2DD matrix inversion      c      COST=1e-7
466           DO I=1,5                                         COST=1.
467              DAL(I)=0.                     DO I=1,5
468              DO J=1,5                          IF(CHI2DD(I,I).NE.0.)COST=COST/DABS(CHI2DD(I,I))**0.2
469                 COV(I,J)=2.*COST*CHI2DD(I,J)           ENDDO
470              ENDDO                         DO I=1,5
471           ENDDO                                DO J=1,5
472        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)  
473              ENDDO              ENDDO
474           ENDDO           ENDDO
475           CALL DSFACT(4,CHI2DD_R,4,IFA,DET,JFA)           IF(PFIXED.EQ.0.) THEN
476           IF(IFA.NE.0) THEN              CALL DSFACT(5,CHI2DD,5,IFA,DET,JFA) !CHI2DD matrix determinant
477              if(TRKVERBOSE)then              IF(IFA.NE.0) THEN   !not positive-defined      
478                 PRINT *,                 if(TRKVERBOSE)then
479       $              '*** ERROR in mini ***'//                    PRINT *,
480       $              'on matrix inversion (not pos-def)'       $                 '*** ERROR in mini ***'//
481       $              ,DET       $                 'on matrix inversion (not pos-def)'
482              endif       $                 ,DET
483              IF(CHI2.EQ.0) CHI2=-9999.                 endif
484              IF(CHI2.GT.0) CHI2=-CHI2                 IF(CHI2.EQ.0) CHI2=-9999.
485              IFAIL=1                 IF(CHI2.GT.0) CHI2=-CHI2
486              RETURN                             IFAIL=1
487                   RETURN            
488                ENDIF
489                CALL DSFINV(5,CHI2DD,5) !CHI2DD matrix inversion    
490                DO I=1,5                              
491    c$$$               DAL(I)=0.          
492                   DO J=1,5            
493                      COV(I,J)=2.*COST*CHI2DD(I,J)
494                   ENDDO              
495                ENDDO                  
496             ELSE
497                DO I=1,4
498                   CHI2D_R(I)=CHI2D(I)
499                   DO J=1,4
500                      CHI2DD_R(I,J)=CHI2DD(I,J)
501                   ENDDO
502                ENDDO
503                CALL DSFACT(4,CHI2DD_R,4,IFA,DET,JFA)
504                IF(IFA.NE.0) THEN
505                   if(TRKVERBOSE)then
506                      PRINT *,
507         $                 '*** ERROR in mini ***'//
508         $                 'on matrix inversion (not pos-def)'
509         $                 ,DET
510                   endif
511                   IF(CHI2.EQ.0) CHI2=-9999.
512                   IF(CHI2.GT.0) CHI2=-CHI2
513                   IFAIL=1
514                   RETURN            
515                ENDIF
516                CALL DSFINV(4,CHI2DD_R,4)
517                DO I=1,4
518    c$$$               DAL(I)=0.
519                   DO J=1,4
520                      COV(I,J)=2.*COST*CHI2DD_R(I,J)
521                   ENDDO
522                ENDDO
523           ENDIF           ENDIF
524           CALL DSFINV(4,CHI2DD_R,4)  
525           DO I=1,4        ENDIF
526              DAL(I)=0.  
527              DO J=1,4  * -------------------------------
528                 COV(I,J)=2.*COST*CHI2DD_R(I,J)  * **** Likelihood+student minimization
529    * -------------------------------
530    
531          IF(STUDENT) THEN
532             CALL CHISQSTT(1,JFAIL)
533             DO I=1,5
534                DO j=1,5
535                   COV(I,J) = 2.*CHI2DD(I,J)
536              ENDDO              ENDDO
537           ENDDO           ENDDO
538        ENDIF        ENDIF
539    
540  *****************************  *****************************
541    
542  *     ------------------------------------  *     ------------------------------------
# Line 364  c$$$      print*,'chi2 -- ',DCHI2 Line 555  c$$$      print*,'chi2 -- ',DCHI2
555       $        print*,'*** WARNING *** in mini n.dof = 0 (set to 1)'       $        print*,'*** WARNING *** in mini n.dof = 0 (set to 1)'
556        endif        endif
557    
       if(TRKDEBUG) print*,'mini2: -ok- ',istep,chi2,1./AL(5)  
   
558  *     ------------------------------------  *     ------------------------------------
559  *     Reduced chi^2  *     Reduced chi^2
560        CHI2 = CHI2/dble(ndof)        CHI2 = CHI2/dble(ndof)
   
561  c      print*,'mini2: chi2 ',chi2  c      print*,'mini2: chi2 ',chi2
562    
563   11   CONTINUE         11   CONTINUE      
564    
565          if(TRKDEBUG) print*,'mini2: -ok- ',istep,chi2,AL(5)
566    
567        NSTEP=ISTEP ! ***PP***        NSTEP=ISTEP ! ***PP***
568    
569    c$$$      print*,'>>>>> NSTEP = ',NSTEP
570    
571        RETURN        RETURN
572        END                END        
573    
# Line 441  c$$$      ENDDO Line 633  c$$$      ENDDO
633  *     measured position of the cluster.  *     measured position of the cluster.
634  *     ---------------------------------------------------------  *     ---------------------------------------------------------
635        CHI2=0.        CHI2=0.
636        DO I=1,nplanes        DO I=1,nplanes        
637           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
638              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))
639              ALFA = XM_A(I) - BETA * YM_A(I)              ALFA = XM_A(I) - BETA * YM_A(I)
# Line 597  c$$$      print*,'CHISQ ',chi2 Line 789  c$$$      print*,'CHISQ ',chi2
789        RETURN        RETURN
790        END        END
791    
792    ******************************************************************************    
793    *    
794    *     routine to compute Likelihodd+Student and its derivatives
795    *    
796    *     (modified in respect to the previous one in order to include
797    *     single clusters. In this case the residual is evaluated by
798    *     calculating the distance between the track intersection and the
799    *     segment AB associated to the single cluster)
800    *
801    ******************************************************************************
802    
803          SUBROUTINE CHISQSTT(IFLAG,JFAIL)
804    
805          IMPLICIT DOUBLE PRECISION (A-H,O-Z)
806    
807          include 'commontracker.f' !tracker general common
808          include 'common_mini_2.f' !common for the tracking procedure
809    
810          LOGICAL TRKDEBUG,TRKVERBOSE
811          COMMON/TRKD/TRKDEBUG,TRKVERBOSE
812    
813          DIMENSION AL_P(5)
814          DIMENSION VECTEMP(5)
815    c$$$      DIMENSION U(5) ! BFGS
816    
817          DO I=1,5
818             AL_P(I)=AL(I)
819          ENDDO
820          JFAIL=0                   !error flag
821          CALL POSXYZ(AL_P,JFAIL)   !track intersection with tracking planes
822          IF(JFAIL.NE.0) THEN
823             IF(TRKVERBOSE)
824         $        PRINT *,'CHISQSTT ==> error from trk routine POSXYZ !!'
825             IFAIL=1
826             RETURN
827          ENDIF
828    
829          DO I=1,nplanes
830             DXDAL(I,1)=1.
831             DYDAL(I,1)=0.
832             DXDAL(I,2)=0.
833             DYDAL(I,2)=1.
834             COSTHE=DSQRT(1.-AL(3)**2)
835             IF(COSTHE.EQ.0.) THEN
836                IF(TRKVERBOSE)PRINT *,'=== WARNING ===> COSTHE=0'
837                IFAIL=1
838                RETURN
839             ENDIF
840             DXDAL(I,3)=(ZINI-ZM(I))*DCOS(AL(4))/COSTHE**3
841             DYDAL(I,3)=(ZINI-ZM(I))*DSIN(AL(4))/COSTHE**3
842             DXDAL(I,4)=-AL(3)*(ZINI-ZM(I))*DSIN(AL(4))/COSTHE
843             DYDAL(I,4)=AL(3)*(ZINI-ZM(I))*DCOS(AL(4))/COSTHE
844             IF(AL(5).NE.0.) THEN      
845                DXDAL(I,5)=
846         +           (XV(I)-(AL(1)+AL(3)/COSTHE*(ZINI-ZM(I))
847         +           *DCOS(AL(4))))/AL(5)
848                DYDAL(I,5)=
849         +           (YV(I)-(AL(2)+AL(3)/COSTHE*(ZINI-ZM(I))
850         +           *DSIN(AL(4))))/AL(5)
851             ELSE
852                DXDAL(I,5)=100.*( 0.25 *0.3*0.4*(0.01*(ZINI-ZM(I)))**2 )
853                DYDAL(I,5)=0.
854             ENDIF
855          ENDDO
856    
857          IF(IFLAG.EQ.0) THEN ! function calulation
858             CHI2=0.
859             DO I=1,nplanes
860                IF(XGOOD(I).EQ.1.AND.YGOOD(I).EQ.0)THEN !X-cl
861                   BETA = (XM_B(I)-XM_A(I))/(YM_B(I)-YM_A(I))
862                   ALFA = XM_A(I) - BETA * YM_A(I)
863                   YM(I) = ( YV(I) + BETA*XV(I) - BETA*ALFA )/(1+BETA**2)
864                   if(YM(I).lt.dmin1(YM_A(I),YM_B(I)))
865         $              YM(I)=dmin1(YM_A(I),YM_B(I))
866                   if(YM(I).gt.dmax1(YM_A(I),YM_B(I)))
867         $              YM(I)=dmax1(YM_A(I),YM_B(I))
868                   XM(I) = ALFA + BETA * YM(I) !<<<< measured coordinates
869                ELSEIF(XGOOD(I).EQ.0.AND.YGOOD(I).EQ.1)THEN !Y-cl
870                   BETA = (YM_B(I)-YM_A(I))/(XM_B(I)-XM_A(I))
871                   ALFA = YM_A(I) - BETA * XM_A(I)
872                   XM(I) = ( XV(I) + BETA*YV(I) - BETA*ALFA )/(1+BETA**2)
873                   if(XM(I).lt.dmin1(XM_A(I),XM_B(I)))
874         $              XM(I)=dmin1(XM_A(I),XM_B(I))
875                   if(XM(I).gt.dmax1(XM_A(I),XM_B(I)))
876         $              XM(I)=dmax1(XM_A(I),XM_B(I))
877                   YM(I) = ALFA + BETA * XM(I) !<<<< measured coordinates
878                ENDIF
879                TERMX = DLOG( (TAILX(I)*RESX(I)**2+(XV(I)-XM(I))**2)/
880         $           (TAILX(I)*RESX(I)**2) )
881                TERMY = DLOG( (TAILY(I)*RESY(I)**2+(YV(I)-YM(I))**2)/
882         $           (TAILY(I)*RESY(I)**2) )
883                CHI2=CHI2
884         $           +(TAILX(I)+1.0)*TERMX   *( XGOOD(I) )
885         $           +(TAILY(I)+1.0)*TERMY   *( YGOOD(I) )
886             ENDDO
887          ENDIF
888    
889          IF(IFLAG.EQ.1) THEN ! derivative calulation
890             DO I=1,5
891                CHI2DOLD(I)=CHI2D(I)
892             ENDDO
893             DO J=1,5
894                CHI2D(J)=0.      
895                DO I=1,nplanes
896                   CHI2D(J)=CHI2D(J)
897         $              +2.*(TAILX(I)+1.0)*(XV(I)-XM(I))/
898         $              (TAILX(I)*RESX(I)**2+(XV(I)-XM(I))**2)*
899         $              DXDAL(I,J)   *XGOOD(I)
900         $              +2.*(TAILY(I)+1.0)*(YV(I)-YM(I))/
901         $              (TAILY(I)*RESY(I)**2+(YV(I)-YM(I))**2)*
902         $              DYDAL(I,J)   *YGOOD(I)
903                ENDDO
904             ENDDO
905             DO K=1,5
906                VECTEMP(K)=0.
907                DO M=1,5
908                   VECTEMP(K) = VECTEMP(K) +
909         $              COV(K,M)/2.*(CHI2D(M)-CHI2DOLD(M))
910                ENDDO
911             ENDDO
912             DOWN1 = 0.
913             DO K=1,5
914                DOWN1 = DOWN1 + DAL(K)*(CHI2D(K)-CHI2DOLD(K))
915             ENDDO
916             IF(DOWN1.EQ.0.) THEN
917                PRINT*,'WARNING IN MATRIX CALULATION (STUDENT), DOWN1 = 0'
918                IFAIL=1
919                RETURN
920             ENDIF
921             DOWN2 = 0.
922             DO K=1,5
923                DO M=1,5
924                   DOWN2 = DOWN2 + (CHI2D(K)-CHI2DOLD(K))*VECTEMP(K)
925                ENDDO
926             ENDDO
927             IF(DOWN2.EQ.0.) THEN
928                PRINT*,'WARNING IN MATRIX CALULATION (STUDENT), DOWN2 = 0'
929                IFAIL=1
930                RETURN
931             ENDIF
932    c$$$         DO K=1,5 ! BFGS
933    c$$$            U(K) = DAL(K)/DOWN1 - VECTEMP(K)/DOWN2
934    c$$$         ENDDO
935             DO I=1,5
936                DO J=1,5
937                   CHI2DD(I,J) = COV(I,J)/2.
938         $              +DAL(I)*DAL(J)/DOWN1
939         $              -VECTEMP(I)*VECTEMP(J)/DOWN2
940    c$$$     $              +DOWN2*U(I)*U(J) ! BFGS
941                ENDDO
942             ENDDO
943          ENDIF
944    
945          RETURN
946          END
947          
948  *****************************************************************  *****************************************************************
949  *  *
950  *     Routine to compute the track intersection points  *     Routine to compute the track intersection points
# Line 636  c      COMMON/TRKD/TRKVERBOSE Line 983  c      COMMON/TRKD/TRKVERBOSE
983  c        c      
984        DIMENSION AL_P(5)        DIMENSION AL_P(5)
985  *      *    
986        DO I=1,nplanes  cpp      DO I=1,nplanes
987           ZV(I)=ZM(I)            !  cpp         ZV(I)=ZM(I)            !
988        ENDDO        cpp      ENDDO      
989  *      *    
990  *     set parameters for GRKUTA  *     set parameters for GRKUTA
991  *      *    
# Line 656  c       Line 1003  c      
1003  c$$$      print*,'POSXY (prima) ',vout  c$$$      print*,'POSXY (prima) ',vout
1004    
1005        DO I=1,nplanes        DO I=1,nplanes
1006           step=vout(3)-zv(i)  c$$$         ipass = 0 ! TEST
1007    c$$$         PRINT *,'TRACKING -> START PLANE: ',I ! TEST
1008    cPPP         step=vout(3)-zm(i)
1009    cPP         step=(zm(i)-vout(3))/VOUT(6)
1010   10      DO J=1,7   10      DO J=1,7
1011              VECT(J)=VOUT(J)              VECT(J)=VOUT(J)
1012              VECTINI(J)=VOUT(J)              VECTINI(J)=VOUT(J)
1013           ENDDO           ENDDO
1014    cPPP         step=vect(3)-zm(i)
1015             IF(VOUT(6).GE.0.) THEN
1016                IFAIL=1
1017                if(TRKVERBOSE)      
1018         $           PRINT *,'posxy (grkuta): WARNING ===> backward track!!'
1019                RETURN
1020             ENDIF
1021             step=(zm(i)-vect(3))/VOUT(6)
1022   11      continue   11      continue
1023           CALL GRKUTA(CHARGE,STEP,VECT,VOUT)           CALL GRKUTA(CHARGE,STEP,VECT,VOUT)
1024    c$$$         ipass = ipass + 1 ! TEST
1025    c$$$         PRINT *,'TRACKING -> STEP: ',ipass,' LENGHT: ', STEP ! TEST
1026           IF(VOUT(3).GT.VECT(3)) THEN           IF(VOUT(3).GT.VECT(3)) THEN
1027              IFAIL=1              IFAIL=1
1028              if(TRKVERBOSE)              if(TRKVERBOSE)
# Line 704  c$$$            if(.TRUE.)print*,'step', Line 1064  c$$$            if(.TRUE.)print*,'step',
1064              VOUT(7) = VOUT(7) * 0.997 !0.9968              VOUT(7) = VOUT(7) * 0.997 !0.9968
1065  *     -----------------------------------------------  *     -----------------------------------------------
1066           ENDIF           ENDIF
1067    c$$$         PRINT *,'TRACKING -> END' ! TEST
1068    
1069        ENDDO        ENDDO
1070    
# Line 742  c$$$      print*,'POSXY (dopo) ',vout Line 1103  c$$$      print*,'POSXY (dopo) ',vout
1103           YM(IP) = -100.         !0.           YM(IP) = -100.         !0.
1104           XM_A(IP) = -100.         !0.           XM_A(IP) = -100.         !0.
1105           YM_A(IP) = -100.         !0.           YM_A(IP) = -100.         !0.
1106  c         ZM_A(IP) = 0           ZM_A(IP) = fitz(nplanes-ip+1) !init to mech. position
1107           XM_B(IP) =  -100.         !0.           XM_B(IP) =  -100.         !0.
1108           YM_B(IP) =  -100.         !0.           YM_B(IP) =  -100.         !0.
1109  c         ZM_B(IP) = 0           ZM_B(IP) = fitz(nplanes-ip+1) !init to mech. position
1110           RESX(IP) = 1000.       !3.d-4           RESX(IP) = 1000.       !3.d-4
1111           RESY(IP) = 1000.       !12.d-4           RESY(IP) = 1000.       !12.d-4
1112           XGOOD(IP) = 0           XGOOD(IP) = 0
1113           YGOOD(IP) = 0           YGOOD(IP) = 0
1114             DEDXTRK_X(IP) = 0
1115             DEDXTRK_Y(IP) = 0
1116             AXV(IP) = 0
1117             AYV(IP) = 0
1118             XV(IP) = -100
1119             YV(IP) = -100
1120        enddo        enddo
1121    
1122        return        return
# Line 822  c      IMPLICIT DOUBLE PRECISION (A-H,O- Line 1189  c      IMPLICIT DOUBLE PRECISION (A-H,O-
1189        ENDDO        ENDDO
1190        IFLAG=0                   !no debug mode        IFLAG=0                   !no debug mode
1191        CALL TRICIRCLE(NP,XP,ZP,AP,RP,CHI,XC,ZC,RADIUS,IFLAG)        CALL TRICIRCLE(NP,XP,ZP,AP,RP,CHI,XC,ZC,RADIUS,IFLAG)
1192  c      print*,' circle: ',XC,ZC,RADIUS,' --- ',CHI,IFLAG  
1193    c$$$      print*,' circle: ',XC,ZC,RADIUS,' --- ',CHI,IFLAG
1194    c$$$      print*,' XP ',(xp(i),i=1,np)
1195    c$$$      print*,' ZP ',(zp(i),i=1,np)
1196    c$$$      print*,' AP ',(ap(i),i=1,np)
1197    c$$$      print*,' XP ',(rp(i),i=1,np)
1198    
1199        IF(IFLAG.NE.0)GOTO 10 !straigth fit        IF(IFLAG.NE.0)GOTO 10 !straigth fit
1200        if(CHI.gt.100)GOTO 10 !straigth fit  c      if(CHI.gt.100)GOTO 10 !straigth fit
1201        ARG = RADIUS**2-(ZINI-ZC)**2        ARG = RADIUS**2-(ZINI-ZC)**2
1202        IF(ARG.LT.0)GOTO 10       !straigth fit        IF(ARG.LT.0)GOTO 10       !straigth fit
1203        DC = SQRT(ARG)              DC = SQRT(ARG)      
# Line 834  c      print*,' circle: ',XC,ZC,RADIUS,' Line 1207  c      print*,' circle: ',XC,ZC,RADIUS,'
1207        DEF=100./(RADIUS*0.3*0.43)        DEF=100./(RADIUS*0.3*0.43)
1208        IF(XC.GT.0)DEF=-DEF        IF(XC.GT.0)DEF=-DEF
1209                
1210    
1211    
1212        IF(ABS(X0).GT.30)THEN        IF(ABS(X0).GT.30)THEN
1213  c$$$         PRINT*,'STRANGE GUESS: XC,ZC,R ',XC,ZC,RADIUS  c$$$         PRINT*,'STRANGE GUESS: XC,ZC,R ',XC,ZC,RADIUS
1214  c$$$     $     ,' - CHI ',CHI,' - X0,AX,DEF ',X0,AX,DEF  c$$$     $     ,' - CHI ',CHI,' - X0,AX,DEF ',X0,AX,DEF
# Line 880  c$$$     $     ,' - CHI ',CHI,' - X0,AX, Line 1255  c$$$     $     ,' - CHI ',CHI,' - X0,AX,
1255        AL(2) = Y0        AL(2) = Y0
1256        tath  = sqrt(AY**2+AX**2)        tath  = sqrt(AY**2+AX**2)
1257        AL(3) = tath/sqrt(1+tath**2)        AL(3) = tath/sqrt(1+tath**2)
 c$$$      IF(AX.NE.0)THEN  
 c$$$         AL(4)= atan(AY/AX)  
 c$$$      ELSE  
 c$$$         AL(4) = acos(-1.)/2  
 c$$$         IF(AY.LT.0)AL(4) = AL(4)+acos(-1.)  
 c$$$  ENDIF  
 c$$$      IF(AX.LT.0)AL(4)= acos(-1.)+ AL(4)  
 c$$$      AL(4) = -acos(-1.) + AL(4) !from incidence direction to tracking ref.sys.  
   
 c$$$      AL(4) =  0.  
 c$$$      IF(AX.NE.0.AND.AY.NE.0)THEN  
 c$$$         AL(4)= atan(AY/AX)  
 c$$$      ELSEIF(AY.EQ.0)THEN  
 c$$$         AL(4) = 0.  
 c$$$         IF(AX.LT.0)AL(4) = AL(4)+acos(-1.)          
 c$$$      ELSEIF(AX.EQ.0)THEN  
 c$$$         AL(4) = acos(-1.)/2  
 c$$$         IF(AY.LT.0)AL(4) = AL(4)+acos(-1.)  
 c$$$      ENDIF  
 c$$$      IF(AX.LT.0)AL(4)= acos(-1.)+ AL(4)  
 c$$$      AL(4) = -acos(-1.) + AL(4) !from incidence direction to tracking ref.sys.  
   
 c$$$      AL(4)=0.  
 c$$$      IF( AX.NE.0.OR.AY.NE.0. ) THEN  
 c$$$         AL(4) = ASIN(AY/SQRT(AX**2+AY**2))  
 c$$$         IF(AX.LT.0.) AL(4) = ACOS(-1.0)-AL(4)  
 c$$$      ENDIF  
1258    
1259        AL(4)=0.        AL(4)=0.
1260        IF( AX.NE.0.OR.AY.NE.0. ) THEN        IF( AX.NE.0.OR.AY.NE.0. ) THEN
Legend:
Removed from v.1.13  
changed lines
  Added in v.1.24
  ViewVC Help
Powered by ViewVC 1.1.23