/[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.17 by pam-fi, Thu May 24 13:29:09 2007 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
71          COMMON/TRKD/TRKDEBUG,TRKVERBOSE
72    
73          DIMENSION AL0(5)
74          LOGICAL SUCCESS_NEW,SUCCESS_OLD
75    *
76    *     define kind of minimization (0x=chi2+gaussian or 1x=likelihood+student)
77    *
78          STUDENT = .false.
79          IF(MOD(INT(TRACKMODE/10),10).EQ.1) STUDENT = .true.
80    
81        IF(IPRINT.EQ.1) THEN        IF(IPRINT.EQ.1) THEN
82           TRKDEBUG = .TRUE.           TRKVERBOSE = .TRUE.
83             TRKDEBUG   = .FALSE.
84          ELSEIF(IPRINT.EQ.2)THEN
85             TRKVERBOSE = .TRUE.
86             TRKDEBUG   = .TRUE.
87        ELSE        ELSE
88           TRKDEBUG = .FALSE.           TRKVERBOSE = .FALSE.
89             TRKDEBUG   = .FALSE.
90        ENDIF                ENDIF        
91    
92  *     ----------------------------------------------------------  *     ----------------------------------------------------------
93    *     evaluate average spatial resolution
94    *     ----------------------------------------------------------
95          AVRESX = RESXAV
96          AVRESY = RESYAV
97          DO IP=1,6
98             IF( XGOOD(IP).EQ.1 )THEN
99                NX=NX+1
100                AVRESX=AVRESX+RESX(IP)
101             ENDIF
102             IF(NX.NE.0)AVRESX=AVRESX/NX
103             IF( YGOOD(IP).EQ.1 )THEN
104                NY=NY+1
105                AVRESY=AVRESY+RESY(IP)
106             ENDIF
107             IF(NX.NE.0)AVRESY=AVRESY/NY        
108          ENDDO
109    
110    *     ----------------------------------------------------------
111  *     define ALTOL(5) ---> tolerances on state vector  *     define ALTOL(5) ---> tolerances on state vector
112  *      *    
113  *     ----------------------------------------------------------  *     ----------------------------------------------------------
114        FACT=10.                  !scale factor to define  *     changed in order to evaluate energy-dependent
115                                  !tolerance on alfa  *     tolerances on all 5 parameters
116        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  
117  c     deflection error (see PDG)  c     deflection error (see PDG)
118        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.))
119        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)
120    c$$$      ALTOL(1) = AVRESX/FACT     !al(1) = x
121    c$$$      ALTOL(2) = AVRESY/FACT     !al(2) = y
122    c$$$      ALTOL(3) = DSQRT(AVRESX**2 !al(3)=sin(theta)
123    c$$$     $     +AVRESY**2)/44.51/FACT
124    c$$$      ALTOL(4) = ALTOL(3)         !al(4)=phi
125    c     deflection error (see PDG)
126    c$$$      DELETA1 = 0.01*AVRESX/0.3/0.4/0.4451**2*SQRT(720./(6.+4.))
127    c$$$      DELETA2 = 0.016/0.3/0.4/0.4451*SQRT(0.4451/9.36)
128  *     ----------------------------------------------------------  *     ----------------------------------------------------------
129  *      *    
130        ISTEP=0                   !num. steps to minimize chi^2        ISTEP=0                   !num. steps to minimize chi^2
131        JFAIL=0                   !error flag        JFAIL=0                   !error flag
132          CHI2=0
133    
134          if(TRKDEBUG) print*,'guess: ',al
135          if(TRKDEBUG) print*,'mini2: step ',istep,chi2,1./AL(5)
136    
137  *      *    
138  *     -----------------------  *     -----------------------
139  *     START MINIMIZATION LOOP  *     START MINIMIZATION LOOP
140  *     -----------------------  *     -----------------------
141   10   ISTEP=ISTEP+1             !<<<<<<<<<<<<<< NEW STEP !!   10   ISTEP=ISTEP+1             !<<<<<<<<<<<<<< NEW STEP !!
142    
143        CALL CHISQ(IFLAG,JFAIL)   !chi^2 and its derivatives  * -------------------------------
144        IF(JFAIL.NE.0) THEN  * **** Chi2+gaussian minimization
145           IFAIL=1  * -------------------------------
          CHI2=-9999.  
          if(TRKDEBUG)  
      $        PRINT *,'*** ERROR in mini *** wrong CHISQ'  
          RETURN  
       ENDIF  
         
 *      CHI2_P=CHI2  
         
 c      print*,'@@@@@ ',istep,' - ',al  
146    
147        COST=1e-7        IF(.NOT.STUDENT) THEN
148        DO I=1,5  
149           DO J=1,5           CALL CHISQ(IFLAG,JFAIL) !chi^2 and its derivatives
150              CHI2DD(I,J)=CHI2DD(I,J)*COST           IF(JFAIL.NE.0) THEN
151                IFAIL=1
152                CHI2=-9999.
153                if(TRKVERBOSE)
154         $           PRINT *,'*** ERROR in mini *** wrong CHISQ'
155                RETURN
156             ENDIF
157            
158    c      COST=1e-5
159             COST=1.
160             DO I=1,5
161                IF(CHI2DD(I,I).NE.0.)COST=COST/DABS(CHI2DD(I,I))**0.2
162             ENDDO
163             DO I=1,5
164                DO J=1,5
165                   CHI2DD(I,J)=CHI2DD(I,J)*COST
166                ENDDO
167    c$$$            CHI2D(I)=CHI2D(I)*COST
168           ENDDO           ENDDO
          CHI2D(I)=CHI2D(I)*COST  
       ENDDO        
169    
170        IF(PFIXED.EQ.0.) THEN           IF(PFIXED.EQ.0.) THEN
171    
172  *------------------------------------------------------------*  *------------------------------------------------------------*
173  *     track fitting with FREE deflection  *     track fitting with FREE deflection
174  *------------------------------------------------------------*  *------------------------------------------------------------*
175           CALL DSFACT(5,CHI2DD,5,IFA,DET,JFA) !CHI2DD matrix determinant              CALL DSFACT(5,CHI2DD,5,IFA,DET,JFA) !CHI2DD matrix determinant
176           IF(IFA.NE.0) THEN      !not positive-defined                    IF(IFA.NE.0) THEN   !not positive-defined      
177              if(TRKDEBUG)then                 if(TRKVERBOSE)then
178                 PRINT *,                    PRINT *,
179       $              '*** ERROR in mini ***'//       $                 '*** ERROR in mini ***'//
180       $              'on matrix inversion (not pos-def)'       $                 'on matrix inversion (not pos-def)'
181       $              ,DET       $                 ,DET
182              endif                 endif
183              IF(CHI2.EQ.0) CHI2=-9999.                 IF(CHI2.EQ.0) CHI2=-9999.
184              IF(CHI2.GT.0) CHI2=-CHI2                 IF(CHI2.GT.0) CHI2=-CHI2
185              IFAIL=1                 IFAIL=1
186              RETURN                             RETURN            
187           ENDIF              ENDIF
188           CALL DSFINV(5,CHI2DD,5) !CHI2DD matrix inversion                  CALL DSFINV(5,CHI2DD,5) !CHI2DD matrix inversion    
189    *     *******************************************
190    *     find new value of AL-pha                
191    *     *******************************************                                        
192                DO I=1,5                              
193                   DAL(I)=0.          
194                   DO J=1,5            
195                      DAL(I)=DAL(I)-CHI2DD(I,J)*CHI2D(J)  *COST
196                      COV(I,J)=2.*COST*CHI2DD(I,J)
197                   ENDDO  
198                ENDDO                  
199                DO I=1,5              
200                   AL(I)=AL(I)+DAL(I)  
201                ENDDO                  
202    *------------------------------------------------------------*
203    *     track fitting with FIXED deflection
204    *------------------------------------------------------------*
205             ELSE
206                AL(5)=1./PFIXED
207                DO I=1,4
208                   CHI2D_R(I)=CHI2D(I)
209                   DO J=1,4
210                      CHI2DD_R(I,J)=CHI2DD(I,J)
211                   ENDDO
212                ENDDO
213                CALL DSFACT(4,CHI2DD_R,4,IFA,DET,JFA)
214                IF(IFA.NE.0) THEN
215                   if(TRKVERBOSE)then
216                      PRINT *,
217         $                 '*** ERROR in mini ***'//
218         $                 'on matrix inversion (not pos-def)'
219         $                 ,DET
220                   endif
221                   IF(CHI2.EQ.0) CHI2=-9999.
222                   IF(CHI2.GT.0) CHI2=-CHI2
223                   IFAIL=1
224                   RETURN            
225                ENDIF
226                CALL DSFINV(4,CHI2DD_R,4)
227  *     *******************************************  *     *******************************************
228  *     find new value of AL-pha                  *     find new value of AL-pha                
229  *                                                *     *******************************************                                        
230                DO I=1,4
231                   DAL(I)=0.
232                   DO J=1,4
233                      DAL(I)=DAL(I)-CHI2DD_R(I,J)*CHI2D_R(J)  *COST
234                      COV(I,J)=2.*COST*CHI2DD_R(I,J)
235                   ENDDO
236                ENDDO
237                DAL(5)=0.
238                DO I=1,4
239                   AL(I)=AL(I)+DAL(I)
240                ENDDO
241             ENDIF
242          
243             if(TRKDEBUG) print*,'mini2: step ',istep,chi2,1./AL(5)
244    
245    c$$$         PRINT*,'DAL ',(DAL(K),K=1,5)
246    c$$$         PRINT*,'CHI2DOLD ',(CHI2DOLD(K),K=1,5)
247    
248    
249          ENDIF
250    
251    * -------------------------------
252    * **** Likelihood+Student minimization
253    * -------------------------------
254    
255          IF(STUDENT) THEN
256             CALL CHISQSTT(1,JFAIL)
257           DO I=1,5                                         DO I=1,5                              
258              DAL(I)=0.                        DAL(I)=0.          
259              DO J=1,5                          DO J=1,5            
260                 DAL(I)=DAL(I)-CHI2DD(I,J)*CHI2D(J)                 DAL(I)=DAL(I)-CHI2DD(I,J)*CHI2D(J)
261                 COV(I,J)=2.*COST*CHI2DD(I,J)              ENDDO  
             ENDDO                
262           ENDDO                             ENDDO                  
263           DO I=1,5                        
264              AL(I)=AL(I)+DAL(I)             DO I=1,5
265           ENDDO                                DO j=1,5
266  *------------------------------------------------------------*                 COV(I,J) = 2.*CHI2DD(I,J)
 *     track fitting with FIXED deflection  
 *------------------------------------------------------------*  
       ELSE  
          AL(5)=1./PFIXED  
          DO I=1,4  
             CHI2D_R(I)=CHI2D(I)  
             DO J=1,4  
                CHI2DD_R(I,J)=CHI2DD(I,J)  
267              ENDDO              ENDDO
268           ENDDO           ENDDO
269           CALL DSFACT(4,CHI2DD_R,4,IFA,DET,JFA)          
270           IF(IFA.NE.0) THEN           CHI2TOLL = 1.E-3
271              if(TRKDEBUG)then           ALPHA = 3.0
272                 PRINT *,           BETA = -0.4
273       $              '*** ERROR in mini ***'//           E=1.
274       $              'on matrix inversion (not pos-def)'           EA=1.
275       $              ,DET           EB=1.
276              endif           EC=1.
277              IF(CHI2.EQ.0) CHI2=-9999.           FA=1.
278              IF(CHI2.GT.0) CHI2=-CHI2           FB=1.
279              IFAIL=1           FC=1.
280              RETURN                       SUCCESS_OLD = .FALSE.
281           ENDIF           SUCCESS_NEW = .FALSE.
282           CALL DSFINV(4,CHI2DD_R,4)  
283           DO I=1,4           CALL CHISQSTT(0,JFAIL)
284              DAL(I)=0.  c$$$         PRINT*,CHI2
285              DO J=1,4           CHI2_NEW = CHI2
286                 DAL(I)=DAL(I)-CHI2DD_R(I,J)*CHI2D_R(J)           FC = CHI2
287                 COV(I,J)=2.*COST*CHI2DD_R(I,J)           EC = 0.
288              ENDDO  
289     100     CONTINUE
290             DO I=1,5
291                AL0(I)=AL(I)
292           ENDDO           ENDDO
293           DAL(5)=0.           DO I=1,5
294           DO I=1,4              AL(I)=AL(I)+E*DAL(I)
             AL(I)=AL(I)+DAL(I)  
295           ENDDO           ENDDO
296             CALL CHISQSTT(0,JFAIL)
297             CHI2_OLD = CHI2_NEW
298             CHI2_NEW = CHI2
299             FA = FB
300             FB = FC
301             FC = CHI2
302             EA = EB
303             EB = EC
304             EC = E
305    
306    c$$$         PRINT*,E,CHI2_NEW
307    
308             IF(CHI2_NEW.LE.CHI2_OLD) THEN ! success
309                IF(DABS(CHI2_NEW-CHI2_OLD).LT.CHI2TOLL) GOTO 101
310                SUCCESS_OLD = SUCCESS_NEW
311                SUCCESS_NEW = .TRUE.
312                E = E*ALPHA
313             ELSE                   ! failure
314                SUCCESS_OLD = SUCCESS_NEW
315                SUCCESS_NEW = .FALSE.
316                CHI2_NEW = CHI2_OLD
317                DO I=1,5
318                   AL(I)=AL0(I)
319                ENDDO
320                IF(SUCCESS_OLD) THEN
321                   DENOM = (EB-EA)*(FB-FC) - (EB-EC)*(FB-FA)
322                   IF(DENOM.NE.0.) THEN
323                      E = EB - 0.5*( (EB-EA)**2*(FB-FC)
324         $                 - (EB-EC)**2*(FB-FA) ) / DENOM
325                   ELSE
326                      E = BETA*E
327                   ENDIF
328                ELSE
329                   E = BETA*E
330                ENDIF
331    c$$$            E = BETA*E
332             ENDIF
333             GOTO 100
334    
335     101     CONTINUE
336    
337             DO I=1,5
338                DAL(I)=E*DAL(I)
339             ENDDO
340    
341    c$$$         print*,' '
342    c$$$         PRINT*,'DAL ',(DAL(K),K=1,5)
343    c$$$         PRINT*,'CHI2DOLD ',(CHI2DOLD(K),K=1,5)
344    c$$$         print*,'==== CHI2 ===='
345    c$$$         print*,chi2
346    c$$$         print*,'==== CHI2d ===='
347    c$$$         print*,(chi2d(i),i=1,5)
348    c$$$         print*,'==== CHI2dd ===='
349    c$$$         do j=1,5
350    c$$$            print*,(chi2dd(j,i),i=1,5)
351    c$$$         enddo
352    c$$$         print*,'================'
353    c$$$         print*,' '
354            
355    *========= FIN QUI =============
356    
357        ENDIF        ENDIF
358    
359            
360    
361    
362    
363  *------------------------------------------------------------*  *------------------------------------------------------------*
364  *     ----------------------------------------------------   *  *     ----------------------------------------------------   *
365  *------------------------------------------------------------*  *------------------------------------------------------------*
 *     *******************************************  
366  *     check parameter bounds:  *     check parameter bounds:
367    *------------------------------------------------------------*
368        DO I=1,5        DO I=1,5
369           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
370              if(TRKDEBUG)then              if(TRKVERBOSE)then
371                 PRINT*,' *** WARNING in mini ***  '                 PRINT*,' *** WARNING in mini ***  '
372                 PRINT*,'MINI_2 ==> AL(',I,') out of range'                 PRINT*,'MINI_2 ==> AL(',I,') out of range'
373                 PRINT*,'         value: ',AL(I),                 PRINT*,'         value: ',AL(I),
# Line 205  ',istep,' - ',al Line 380  ',istep,' - ',al
380              RETURN              RETURN
381           ENDIF           ENDIF
382        ENDDO              ENDDO      
383    *------------------------------------------------------------*
384  *     check number of steps:  *     check number of steps:
385        IF(ISTEP.gt.ISTEPMAX) then  *------------------------------------------------------------*
386           IFAIL=1        IF(ISTEP.ge.ISTEPMAX) then
387           if(TRKDEBUG)  c$$$         IFAIL=1
388       $        PRINT *,'*** WARNING in mini *** ISTEP.GT.ISTEPMAX=',  c$$$         if(TRKVERBOSE)
389       $        ISTEPMAX  c$$$     $        PRINT *,'*** WARNING in mini *** ISTEP.GT.ISTEPMAX=',
390    c$$$     $        ISTEPMAX
391           goto 11           goto 11
392        endif        endif
393    *------------------------------------------------------------*
394  *     ---------------------------------------------  *     ---------------------------------------------
395  *     evaluate deflection tolerance on the basis of  *     evaluate deflection tolerance on the basis of
396  *     estimated deflection  *     estimated deflection
397  *     ---------------------------------------------  *     ---------------------------------------------
398        ALTOL(5)=DSQRT(DELETA1**2+DELETA2**2*AL(5)**2)/FACT  *------------------------------------------------------------*
399    c$$$      ALTOL(5) = DSQRT(DELETA1**2+DELETA2**2*AL(5)**2)/FACT
400          ALTOL(5) = DSQRT((DELETA1*AVRESX)**2+DELETA2**2*AL(5)**2)/FACT
401          ALTOL(1) = ALTOL(5)/DELETA1
402          ALTOL(2) = ALTOL(1)
403          ALTOL(3) = DSQRT(ALTOL(1)**2+ALTOL(2)**2)/44.51
404          ALTOL(4) = ALTOL(3)        
405          
406    c$$$      print*,' -- ',(DAL(I),ALTOL(I),' - ',i=1,5) !>>>> new step!
407    
408  *---- check tolerances:  *---- check tolerances:
409    c$$$      DO I=1,5
410    c$$$         if(TRKVERBOSE)print*,i,' -- ',DAL(I),ALTOL(I) !>>>> new step!
411    c$$$      ENDDO
412    c$$$      print*,'chi2 -- ',DCHI2
413    
414          IF(ISTEP.LT.ISTEPMIN) GOTO 10 ! ***PP***
415        DO I=1,5        DO I=1,5
416           IF(ABS(DAL(I)).GT.ALTOL(I))GOTO 10 !>>>> new step!           IF(ABS(DAL(I)).GT.ALTOL(I))GOTO 10 !>>>> new step!
417        ENDDO        ENDDO
418    
419  *     new estimate of chi^2:  *****************************
420        JFAIL=0                   !error flag  *     final estimate of chi^2
421        CALL CHISQ(IFLAG,JFAIL)   !chi^2 and its derivatives  *****************************
422        IF(JFAIL.NE.0) THEN  
423           IFAIL=1  * -------------------------------
424           if(TRKDEBUG)THEN  * **** Chi2+gaussian minimization
425              CHI2=-9999.  * -------------------------------
426           if(TRKDEBUG)  
427       $        PRINT *,'*** ERROR in mini *** wrong CHISQ'        IF(.NOT.STUDENT) THEN
428           ENDIF  
429           RETURN           JFAIL=0                !error flag
430        ENDIF           CALL CHISQ(IFLAG,JFAIL) !chi^2 and its derivatives
431        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  
432              IFAIL=1              IFAIL=1
433              RETURN                          if(TRKVERBOSE)THEN
434                   CHI2=-9999.
435                   if(TRKVERBOSE)
436         $              PRINT *,'*** ERROR in mini *** wrong CHISQ'
437                ENDIF
438                RETURN
439           ENDIF           ENDIF
440           CALL DSFINV(5,CHI2DD,5) !CHI2DD matrix inversion      c      COST=1e-7
441           DO I=1,5                                         COST=1.
442              DAL(I)=0.                     DO I=1,5
443              DO J=1,5                          IF(CHI2DD(I,I).NE.0.)COST=COST/DABS(CHI2DD(I,I))**0.2
444                 COV(I,J)=2.*COST*CHI2DD(I,J)           ENDDO
445              ENDDO                         DO I=1,5
446           ENDDO                                DO J=1,5
447        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)  
448              ENDDO              ENDDO
449           ENDDO           ENDDO
450           CALL DSFACT(4,CHI2DD_R,4,IFA,DET,JFA)           IF(PFIXED.EQ.0.) THEN
451           IF(IFA.NE.0) THEN              CALL DSFACT(5,CHI2DD,5,IFA,DET,JFA) !CHI2DD matrix determinant
452              if(TRKDEBUG)then              IF(IFA.NE.0) THEN   !not positive-defined      
453                 PRINT *,                 if(TRKVERBOSE)then
454       $              '*** ERROR in mini ***'//                    PRINT *,
455       $              'on matrix inversion (not pos-def)'       $                 '*** ERROR in mini ***'//
456       $              ,DET       $                 'on matrix inversion (not pos-def)'
457              endif       $                 ,DET
458              IF(CHI2.EQ.0) CHI2=-9999.                 endif
459              IF(CHI2.GT.0) CHI2=-CHI2                 IF(CHI2.EQ.0) CHI2=-9999.
460              IFAIL=1                 IF(CHI2.GT.0) CHI2=-CHI2
461              RETURN                             IFAIL=1
462                   RETURN            
463                ENDIF
464                CALL DSFINV(5,CHI2DD,5) !CHI2DD matrix inversion    
465                DO I=1,5                              
466    c$$$               DAL(I)=0.          
467                   DO J=1,5            
468                      COV(I,J)=2.*COST*CHI2DD(I,J)
469                   ENDDO              
470                ENDDO                  
471             ELSE
472                DO I=1,4
473                   CHI2D_R(I)=CHI2D(I)
474                   DO J=1,4
475                      CHI2DD_R(I,J)=CHI2DD(I,J)
476                   ENDDO
477                ENDDO
478                CALL DSFACT(4,CHI2DD_R,4,IFA,DET,JFA)
479                IF(IFA.NE.0) THEN
480                   if(TRKVERBOSE)then
481                      PRINT *,
482         $                 '*** ERROR in mini ***'//
483         $                 'on matrix inversion (not pos-def)'
484         $                 ,DET
485                   endif
486                   IF(CHI2.EQ.0) CHI2=-9999.
487                   IF(CHI2.GT.0) CHI2=-CHI2
488                   IFAIL=1
489                   RETURN            
490                ENDIF
491                CALL DSFINV(4,CHI2DD_R,4)
492                DO I=1,4
493    c$$$               DAL(I)=0.
494                   DO J=1,4
495                      COV(I,J)=2.*COST*CHI2DD_R(I,J)
496                   ENDDO
497                ENDDO
498           ENDIF           ENDIF
499           CALL DSFINV(4,CHI2DD_R,4)  
500           DO I=1,4        ENDIF
501              DAL(I)=0.  
502              DO J=1,4  * -------------------------------
503                 COV(I,J)=2.*COST*CHI2DD_R(I,J)  * **** Likelihood+student minimization
504    * -------------------------------
505    
506          IF(STUDENT) THEN
507             CALL CHISQSTT(1,JFAIL)
508             DO I=1,5
509                DO j=1,5
510                   COV(I,J) = 2.*CHI2DD(I,J)
511              ENDDO              ENDDO
512           ENDDO           ENDDO
513        ENDIF        ENDIF
514    
515  *****************************  *****************************
516    
517  *     ------------------------------------  *     ------------------------------------
# Line 306  ',istep,' - ',al Line 526  ',istep,' - ',al
526        if(pfixed.ne.0.) ndof=ndof-4 ! ***PP***        if(pfixed.ne.0.) ndof=ndof-4 ! ***PP***
527        if(ndof.le.0.) then        if(ndof.le.0.) then
528           ndof = 1           ndof = 1
529           if(TRKDEBUG)           if(TRKVERBOSE)
530       $        print*,'*** WARNING *** in mini n.dof = 0 (set to 1)'       $        print*,'*** WARNING *** in mini n.dof = 0 (set to 1)'
531        endif        endif
532    
533  *     ------------------------------------  *     ------------------------------------
534  *     Reduced chi^2  *     Reduced chi^2
535        CHI2 = CHI2/dble(ndof)        CHI2 = CHI2/dble(ndof)
536    
537    c      print*,'mini2: chi2 ',chi2
538    
539   11   CONTINUE         11   CONTINUE      
540    
541          if(TRKDEBUG) print*,'mini2: -ok- ',istep,chi2,1./AL(5)
542    
543        NSTEP=ISTEP ! ***PP***        NSTEP=ISTEP ! ***PP***
544    
545    c$$$      print*,'>>>>> NSTEP = ',NSTEP
546    
547        RETURN        RETURN
548        END                END        
549    
# Line 343  ',istep,' - ',al Line 570  ',istep,' - ',al
570       $     ,XV0(nplanes),YV0(nplanes)       $     ,XV0(nplanes),YV0(nplanes)
571        DIMENSION AL_P(5)        DIMENSION AL_P(5)
572    
573        LOGICAL TRKDEBUG  c      LOGICAL TRKVERBOSE
574        COMMON/TRKD/TRKDEBUG  c      COMMON/TRKD/TRKVERBOSE
575          LOGICAL TRKDEBUG,TRKVERBOSE
576          COMMON/TRKD/TRKDEBUG,TRKVERBOSE
577  *      *    
578  *     chi^2 computation  *     chi^2 computation
579  *      *    
# Line 354  ',istep,' - ',al Line 583  ',istep,' - ',al
583        JFAIL=0                   !error flag        JFAIL=0                   !error flag
584        CALL POSXYZ(AL_P,JFAIL)   !track intersection with tracking planes        CALL POSXYZ(AL_P,JFAIL)   !track intersection with tracking planes
585        IF(JFAIL.NE.0) THEN        IF(JFAIL.NE.0) THEN
586           IF(TRKDEBUG)           IF(TRKVERBOSE)
587       $        PRINT *,'CHISQ ==> error from trk routine POSXYZ !!'       $        PRINT *,'CHISQ ==> error from trk routine POSXYZ !!'
588           IFAIL=1           IFAIL=1
589           RETURN           RETURN
# Line 380  c$$$      ENDDO Line 609  c$$$      ENDDO
609  *     measured position of the cluster.  *     measured position of the cluster.
610  *     ---------------------------------------------------------  *     ---------------------------------------------------------
611        CHI2=0.        CHI2=0.
612        DO I=1,nplanes        DO I=1,nplanes        
613           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
614              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))
615              ALFA = XM_A(I) - BETA * YM_A(I)              ALFA = XM_A(I) - BETA * YM_A(I)
# Line 407  c$$$      ENDDO Line 636  c$$$      ENDDO
636       +                                       *( XGOOD(I)*(1-YGOOD(I)) )       +                                       *( XGOOD(I)*(1-YGOOD(I)) )
637       +        +((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
638       +                                       *( (1-XGOOD(I))*YGOOD(I) )       +                                       *( (1-XGOOD(I))*YGOOD(I) )
639    c$$$         print*,(XV(I)-XM(I))**2/RESX(i)**2   *( XGOOD(I)*YGOOD(I) )
640    c$$$         print*,(YV(I)-YM(I))**2/RESY(i)**2   *( YGOOD(I)*XGOOD(I) )
641    c$$$         print*,((XV(I)-XM(I))**2+(YV(I)-YM(I))**2)/RESX(i)**2
642    c$$$     +        *( XGOOD(I)*(1-YGOOD(I)) )
643    c$$$         print*,((XV(I)-XM(I))**2+(YV(I)-YM(I))**2)/RESY(i)**2
644    c$$$     +        *( (1-XGOOD(I))*YGOOD(I) )
645    c$$$         print*,XV(I),XM(I),XGOOD(I)
646    c$$$         print*,YV(I),YM(I),YGOOD(I)
647        ENDDO        ENDDO
648    c$$$      print*,'CHISQ ',chi2
649  *     ------------------------------------------------  *     ------------------------------------------------
650  *      *    
651  *     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 664  c$$$      ENDDO
664              JFAIL=0              JFAIL=0
665              CALL POSXYZ(AL_P,JFAIL)              CALL POSXYZ(AL_P,JFAIL)
666              IF(JFAIL.NE.0) THEN              IF(JFAIL.NE.0) THEN
667                 IF(TRKDEBUG)                 IF(TRKVERBOSE)
668  *23456789012345678901234567890123456789012345678901234567890123456789012  *23456789012345678901234567890123456789012345678901234567890123456789012
669       $              PRINT *,'CHISQ ==> error from trk routine POSXYZ'       $              PRINT *,'CHISQ ==> error from trk routine POSXYZ'
670                 IFAIL=1                 IFAIL=1
# Line 440  c$$$      ENDDO Line 678  c$$$      ENDDO
678              JFAIL=0              JFAIL=0
679              CALL POSXYZ(AL_P,JFAIL)              CALL POSXYZ(AL_P,JFAIL)
680              IF(JFAIL.NE.0) THEN              IF(JFAIL.NE.0) THEN
681                 IF(TRKDEBUG)                 IF(TRKVERBOSE)
682       $              PRINT *,'CHISQ ==> error from trk routine POSXYZ'       $              PRINT *,'CHISQ ==> error from trk routine POSXYZ'
683                 IFAIL=1                 IFAIL=1
684                 RETURN                 RETURN
# Line 472  c$$$      ENDDO Line 710  c$$$      ENDDO
710                            
711              COSTHE=DSQRT(1.-AL(3)**2)              COSTHE=DSQRT(1.-AL(3)**2)
712              IF(COSTHE.EQ.0.) THEN              IF(COSTHE.EQ.0.) THEN
713                 IF(TRKDEBUG)PRINT *,'=== WARNING ===> COSTHE=0'                 IF(TRKVERBOSE)PRINT *,'=== WARNING ===> COSTHE=0'
714                 IFAIL=1                 IFAIL=1
715                 RETURN                 RETURN
716              ENDIF              ENDIF
# Line 527  c$$$      ENDDO Line 765  c$$$      ENDDO
765        RETURN        RETURN
766        END        END
767    
768    ******************************************************************************    
769    *    
770    *     routine to compute Likelihodd+Student and its derivatives
771    *    
772    *     (modified in respect to the previous one in order to include
773    *     single clusters. In this case the residual is evaluated by
774    *     calculating the distance between the track intersection and the
775    *     segment AB associated to the single cluster)
776    *
777    ******************************************************************************
778    
779          SUBROUTINE CHISQSTT(IFLAG,JFAIL)
780    
781          IMPLICIT DOUBLE PRECISION (A-H,O-Z)
782    
783          include 'commontracker.f' !tracker general common
784          include 'common_mini_2.f' !common for the tracking procedure
785    
786          LOGICAL TRKDEBUG,TRKVERBOSE
787          COMMON/TRKD/TRKDEBUG,TRKVERBOSE
788    
789          DIMENSION AL_P(5)
790          DIMENSION VECTEMP(5)
791    c$$$      DIMENSION U(5) ! BFGS
792    
793          DO I=1,5
794             AL_P(I)=AL(I)
795          ENDDO
796          JFAIL=0                   !error flag
797          CALL POSXYZ(AL_P,JFAIL)   !track intersection with tracking planes
798          IF(JFAIL.NE.0) THEN
799             IF(TRKVERBOSE)
800         $        PRINT *,'CHISQSTT ==> error from trk routine POSXYZ !!'
801             IFAIL=1
802             RETURN
803          ENDIF
804    
805          DO I=1,nplanes
806             DXDAL(I,1)=1.
807             DYDAL(I,1)=0.
808             DXDAL(I,2)=0.
809             DYDAL(I,2)=1.
810             COSTHE=DSQRT(1.-AL(3)**2)
811             IF(COSTHE.EQ.0.) THEN
812                IF(TRKVERBOSE)PRINT *,'=== WARNING ===> COSTHE=0'
813                IFAIL=1
814                RETURN
815             ENDIF
816             DXDAL(I,3)=(ZINI-ZM(I))*DCOS(AL(4))/COSTHE**3
817             DYDAL(I,3)=(ZINI-ZM(I))*DSIN(AL(4))/COSTHE**3
818             DXDAL(I,4)=-AL(3)*(ZINI-ZM(I))*DSIN(AL(4))/COSTHE
819             DYDAL(I,4)=AL(3)*(ZINI-ZM(I))*DCOS(AL(4))/COSTHE
820             IF(AL(5).NE.0.) THEN      
821                DXDAL(I,5)=
822         +           (XV(I)-(AL(1)+AL(3)/COSTHE*(ZINI-ZM(I))
823         +           *DCOS(AL(4))))/AL(5)
824                DYDAL(I,5)=
825         +           (YV(I)-(AL(2)+AL(3)/COSTHE*(ZINI-ZM(I))
826         +           *DSIN(AL(4))))/AL(5)
827             ELSE
828                DXDAL(I,5)=100.*( 0.25 *0.3*0.4*(0.01*(ZINI-ZM(I)))**2 )
829                DYDAL(I,5)=0.
830             ENDIF
831          ENDDO
832    
833          IF(IFLAG.EQ.0) THEN ! function calulation
834             CHI2=0.
835             DO I=1,nplanes
836                IF(XGOOD(I).EQ.1.AND.YGOOD(I).EQ.0)THEN !X-cl
837                   BETA = (XM_B(I)-XM_A(I))/(YM_B(I)-YM_A(I))
838                   ALFA = XM_A(I) - BETA * YM_A(I)
839                   YM(I) = ( YV(I) + BETA*XV(I) - BETA*ALFA )/(1+BETA**2)
840                   if(YM(I).lt.dmin1(YM_A(I),YM_B(I)))
841         $              YM(I)=dmin1(YM_A(I),YM_B(I))
842                   if(YM(I).gt.dmax1(YM_A(I),YM_B(I)))
843         $              YM(I)=dmax1(YM_A(I),YM_B(I))
844                   XM(I) = ALFA + BETA * YM(I) !<<<< measured coordinates
845                ELSEIF(XGOOD(I).EQ.0.AND.YGOOD(I).EQ.1)THEN !Y-cl
846                   BETA = (YM_B(I)-YM_A(I))/(XM_B(I)-XM_A(I))
847                   ALFA = YM_A(I) - BETA * XM_A(I)
848                   XM(I) = ( XV(I) + BETA*YV(I) - BETA*ALFA )/(1+BETA**2)
849                   if(XM(I).lt.dmin1(XM_A(I),XM_B(I)))
850         $              XM(I)=dmin1(XM_A(I),XM_B(I))
851                   if(XM(I).gt.dmax1(XM_A(I),XM_B(I)))
852         $              XM(I)=dmax1(XM_A(I),XM_B(I))
853                   YM(I) = ALFA + BETA * XM(I) !<<<< measured coordinates
854                ENDIF
855                TERMX = DLOG( (TAILX(I)*RESX(I)**2+(XV(I)-XM(I))**2)/
856         $           (TAILX(I)*RESX(I)**2) )
857                TERMY = DLOG( (TAILY(I)*RESY(I)**2+(YV(I)-YM(I))**2)/
858         $           (TAILY(I)*RESY(I)**2) )
859                CHI2=CHI2
860         $           +(TAILX(I)+1.0)*TERMX   *( XGOOD(I) )
861         $           +(TAILY(I)+1.0)*TERMY   *( YGOOD(I) )
862             ENDDO
863          ENDIF
864    
865          IF(IFLAG.EQ.1) THEN ! derivative calulation
866             DO I=1,5
867                CHI2DOLD(I)=CHI2D(I)
868             ENDDO
869             DO J=1,5
870                CHI2D(J)=0.      
871                DO I=1,nplanes
872                   CHI2D(J)=CHI2D(J)
873         $              +2.*(TAILX(I)+1.0)*(XV(I)-XM(I))/
874         $              (TAILX(I)*RESX(I)**2+(XV(I)-XM(I))**2)*
875         $              DXDAL(I,J)   *XGOOD(I)
876         $              +2.*(TAILY(I)+1.0)*(YV(I)-YM(I))/
877         $              (TAILY(I)*RESY(I)**2+(YV(I)-YM(I))**2)*
878         $              DYDAL(I,J)   *YGOOD(I)
879                ENDDO
880             ENDDO
881             DO K=1,5
882                VECTEMP(K)=0.
883                DO M=1,5
884                   VECTEMP(K) = VECTEMP(K) +
885         $              COV(K,M)/2.*(CHI2D(M)-CHI2DOLD(M))
886                ENDDO
887             ENDDO
888             DOWN1 = 0.
889             DO K=1,5
890                DOWN1 = DOWN1 + DAL(K)*(CHI2D(K)-CHI2DOLD(K))
891             ENDDO
892             IF(DOWN1.EQ.0.) THEN
893                PRINT*,'WARNING IN MATRIX CALULATION (STUDENT), DOWN1 = 0'
894                IFAIL=1
895                RETURN
896             ENDIF
897             DOWN2 = 0.
898             DO K=1,5
899                DO M=1,5
900                   DOWN2 = DOWN2 + (CHI2D(K)-CHI2DOLD(K))*VECTEMP(K)
901                ENDDO
902             ENDDO
903             IF(DOWN2.EQ.0.) THEN
904                PRINT*,'WARNING IN MATRIX CALULATION (STUDENT), DOWN2 = 0'
905                IFAIL=1
906                RETURN
907             ENDIF
908    c$$$         DO K=1,5 ! BFGS
909    c$$$            U(K) = DAL(K)/DOWN1 - VECTEMP(K)/DOWN2
910    c$$$         ENDDO
911             DO I=1,5
912                DO J=1,5
913                   CHI2DD(I,J) = COV(I,J)/2.
914         $              +DAL(I)*DAL(J)/DOWN1
915         $              -VECTEMP(I)*VECTEMP(J)/DOWN2
916    c$$$     $              +DOWN2*U(I)*U(J) ! BFGS
917                ENDDO
918             ENDDO
919          ENDIF
920    
921          RETURN
922          END
923          
924  *****************************************************************  *****************************************************************
925  *  *
926  *     Routine to compute the track intersection points  *     Routine to compute the track intersection points
# Line 559  c$$$      ENDDO Line 952  c$$$      ENDDO
952        include 'commontracker.f' !tracker general common        include 'commontracker.f' !tracker general common
953        include 'common_mini_2.f' !common for the tracking procedure        include 'common_mini_2.f' !common for the tracking procedure
954    
955        LOGICAL TRKDEBUG  c      LOGICAL TRKVERBOSE
956        COMMON/TRKD/TRKDEBUG  c      COMMON/TRKD/TRKVERBOSE
957          LOGICAL TRKDEBUG,TRKVERBOSE
958          COMMON/TRKD/TRKDEBUG,TRKVERBOSE
959  c        c      
960        DIMENSION AL_P(5)        DIMENSION AL_P(5)
961  *      *    
962        DO I=1,nplanes  cpp      DO I=1,nplanes
963           ZV(I)=ZM(I)            !  cpp         ZV(I)=ZM(I)            !
964        ENDDO        cpp      ENDDO      
965  *      *    
966  *     set parameters for GRKUTA  *     set parameters for GRKUTA
967  *      *    
# Line 580  c       Line 975  c      
975        VOUT(6)=-1.*DSQRT(1.-AL_P(3)**2)        VOUT(6)=-1.*DSQRT(1.-AL_P(3)**2)
976        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))
977        IF(AL_P(5).EQ.0.) VOUT(7)=1.E8        IF(AL_P(5).EQ.0.) VOUT(7)=1.E8
978    
979    c$$$      print*,'POSXY (prima) ',vout
980    
981        DO I=1,nplanes        DO I=1,nplanes
982           step=vout(3)-zv(i)  cpp         step=vout(3)-zv(i)
983             step=vout(3)-zm(i)
984   10      DO J=1,7   10      DO J=1,7
985              VECT(J)=VOUT(J)              VECT(J)=VOUT(J)
986              VECTINI(J)=VOUT(J)              VECTINI(J)=VOUT(J)
# Line 590  c       Line 989  c      
989           CALL GRKUTA(CHARGE,STEP,VECT,VOUT)           CALL GRKUTA(CHARGE,STEP,VECT,VOUT)
990           IF(VOUT(3).GT.VECT(3)) THEN           IF(VOUT(3).GT.VECT(3)) THEN
991              IFAIL=1              IFAIL=1
992              if(TRKDEBUG)              if(TRKVERBOSE)
993       $      PRINT *,'posxy (grkuta): WARNING ===> backward track!!'       $      PRINT *,'posxy (grkuta): WARNING ===> backward track!!'
994              if(.TRUE.)print*,'charge',charge  c$$$            if(.TRUE.)print*,'charge',charge
995              if(.TRUE.)print*,'vect',vect  c$$$            if(.TRUE.)print*,'vect',vect
996              if(.TRUE.)print*,'vout',vout  c$$$            if(.TRUE.)print*,'vout',vout
997              if(.TRUE.)print*,'step',step  c$$$            if(.TRUE.)print*,'step',step
998                if(TRKVERBOSE)print*,'charge',charge
999                if(TRKVERBOSE)print*,'vect',vect
1000                if(TRKVERBOSE)print*,'vout',vout
1001                if(TRKVERBOSE)print*,'step',step
1002              RETURN              RETURN
1003           ENDIF           ENDIF
1004           Z=VOUT(3)           Z=VOUT(3)
# Line 609  c       Line 1012  c      
1012              GOTO 11              GOTO 11
1013           ENDIF           ENDIF
1014    
1015    
1016  *     -----------------------------------------------  *     -----------------------------------------------
1017  *        evaluate track coordinates  *        evaluate track coordinates
1018   100     XV(I)=VOUT(1)   100     XV(I)=VOUT(1)
# Line 618  c       Line 1022  c      
1022           AYV(I)=DATAN(VOUT(5)/VOUT(6))*180./ACOS(-1.)           AYV(I)=DATAN(VOUT(5)/VOUT(6))*180./ACOS(-1.)
1023  *     -----------------------------------------------  *     -----------------------------------------------
1024    
1025             IF(TRACKMODE.EQ.1) THEN
1026    *     -----------------------------------------------
1027    *        change of energy by bremsstrahlung for electrons
1028                VOUT(7) = VOUT(7) * 0.997 !0.9968
1029    *     -----------------------------------------------
1030             ENDIF
1031    
1032        ENDDO        ENDDO
1033    
1034    c$$$      print*,'POSXY (dopo) ',vout
1035    
1036    
1037        RETURN        RETURN
1038        END        END
1039    
# Line 660  c         ZM_B(IP) = 0 Line 1074  c         ZM_B(IP) = 0
1074           RESY(IP) = 1000.       !12.d-4           RESY(IP) = 1000.       !12.d-4
1075           XGOOD(IP) = 0           XGOOD(IP) = 0
1076           YGOOD(IP) = 0           YGOOD(IP) = 0
1077             DEDXTRK_X(IP) = 0
1078             DEDXTRK_Y(IP) = 0
1079             AXV(IP) = 0
1080             AYV(IP) = 0
1081             XV(IP) = -100
1082             YV(IP) = -100
1083        enddo        enddo
1084    
1085        return        return
1086        end        end
1087    
1088    
1089    ***************************************************
1090    *                                                 *
1091    *                                                 *
1092    *                                                 *
1093    *                                                 *
1094    *                                                 *
1095    *                                                 *
1096    **************************************************
1097    
1098          subroutine guess()
1099    
1100    c      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
1101    
1102          include 'commontracker.f' !tracker general common
1103          include 'common_mini_2.f' !common for the tracking procedure
1104          
1105          REAL*4 XP(NPLANES),ZP(NPLANES),AP(NPLANES),RP(NPLANES)
1106          REAL*4 CHI,XC,ZC,RADIUS
1107    *     ----------------------------------------
1108    *     Y view
1109    *     ----------------------------------------
1110    *     ----------------------------------------
1111    *     initial guess with a straigth line
1112    *     ----------------------------------------
1113          SZZ=0.                    
1114          SZY=0.
1115          SSY=0.
1116          SZ=0.
1117          S1=0.
1118          DO I=1,nplanes
1119             IF(YGOOD(I).EQ.1)THEN
1120                YY = YM(I)
1121                IF(XGOOD(I).EQ.0)THEN
1122                   YY = (YM_A(I) + YM_B(I))/2
1123                ENDIF
1124                SZZ=SZZ+ZM(I)*ZM(I)
1125                SZY=SZY+ZM(I)*YY
1126                SSY=SSY+YY
1127                SZ=SZ+ZM(I)
1128                S1=S1+1.
1129             ENDIF
1130          ENDDO
1131          DET=SZZ*S1-SZ*SZ
1132          AY=(SZY*S1-SZ*SSY)/DET
1133          BY=(SZZ*SSY-SZY*SZ)/DET
1134          Y0 = AY*ZINI+BY
1135    *     ----------------------------------------
1136    *     X view
1137    *     ----------------------------------------
1138    *     ----------------------------------------
1139    *     1) initial guess with a circle
1140    *     ----------------------------------------
1141          NP=0
1142          DO I=1,nplanes
1143             IF(XGOOD(I).EQ.1)THEN
1144                XX = XM(I)
1145                IF(YGOOD(I).EQ.0)THEN
1146                   XX = (XM_A(I) + XM_B(I))/2
1147                ENDIF
1148                NP=NP+1
1149                XP(NP)=XX
1150                ZP(NP)=ZM(I)
1151             ENDIF
1152          ENDDO
1153          IFLAG=0                   !no debug mode
1154          CALL TRICIRCLE(NP,XP,ZP,AP,RP,CHI,XC,ZC,RADIUS,IFLAG)
1155    
1156    c$$$      print*,' circle: ',XC,ZC,RADIUS,' --- ',CHI,IFLAG
1157    c$$$      print*,' XP ',(xp(i),i=1,np)
1158    c$$$      print*,' ZP ',(zp(i),i=1,np)
1159    c$$$      print*,' AP ',(ap(i),i=1,np)
1160    c$$$      print*,' XP ',(rp(i),i=1,np)
1161    
1162          IF(IFLAG.NE.0)GOTO 10 !straigth fit
1163    c      if(CHI.gt.100)GOTO 10 !straigth fit
1164          ARG = RADIUS**2-(ZINI-ZC)**2
1165          IF(ARG.LT.0)GOTO 10       !straigth fit
1166          DC = SQRT(ARG)      
1167          IF(XC.GT.0)DC=-DC
1168          X0=XC+DC
1169          AX = -(ZINI-ZC)/DC
1170          DEF=100./(RADIUS*0.3*0.43)
1171          IF(XC.GT.0)DEF=-DEF
1172          
1173    
1174    
1175          IF(ABS(X0).GT.30)THEN
1176    c$$$         PRINT*,'STRANGE GUESS: XC,ZC,R ',XC,ZC,RADIUS
1177    c$$$     $     ,' - CHI ',CHI,' - X0,AX,DEF ',X0,AX,DEF
1178             GOTO 10       !straigth fit
1179          ENDIF
1180          GOTO 20                   !guess is ok
1181    
1182    *     ----------------------------------------
1183    *     2) initial guess with a straigth line
1184    *     - if circle does not intersect reference plane
1185    *     - if bad chi**2
1186    *     ----------------------------------------
1187     10   CONTINUE
1188          SZZ=0.                  
1189          SZX=0.
1190          SSX=0.
1191          SZ=0.
1192          S1=0.
1193          DO I=1,nplanes
1194             IF(XGOOD(I).EQ.1)THEN
1195                XX = XM(I)
1196                IF(YGOOD(I).EQ.0)THEN
1197                   XX = (XM_A(I) + XM_B(I))/2
1198                ENDIF
1199                SZZ=SZZ+ZM(I)*ZM(I)
1200                SZX=SZX+ZM(I)*XX
1201                SSX=SSX+XX
1202                SZ=SZ+ZM(I)
1203                S1=S1+1.
1204             ENDIF
1205          ENDDO
1206          DET=SZZ*S1-SZ*SZ
1207          AX=(SZX*S1-SZ*SSX)/DET
1208          BX=(SZZ*SSX-SZX*SZ)/DET
1209          DEF = 0
1210          X0  = AX*ZINI+BX
1211    
1212     20   CONTINUE
1213    *     ----------------------------------------
1214    *     guess
1215    *     ----------------------------------------
1216    
1217          AL(1) = X0
1218          AL(2) = Y0
1219          tath  = sqrt(AY**2+AX**2)
1220          AL(3) = tath/sqrt(1+tath**2)
1221    c$$$      IF(AX.NE.0)THEN
1222    c$$$         AL(4)= atan(AY/AX)
1223    c$$$      ELSE
1224    c$$$         AL(4) = acos(-1.)/2
1225    c$$$         IF(AY.LT.0)AL(4) = AL(4)+acos(-1.)
1226    c$$$  ENDIF
1227    c$$$      IF(AX.LT.0)AL(4)= acos(-1.)+ AL(4)
1228    c$$$      AL(4) = -acos(-1.) + AL(4) !from incidence direction to tracking ref.sys.
1229    
1230    c$$$      AL(4) =  0.
1231    c$$$      IF(AX.NE.0.AND.AY.NE.0)THEN
1232    c$$$         AL(4)= atan(AY/AX)
1233    c$$$      ELSEIF(AY.EQ.0)THEN
1234    c$$$         AL(4) = 0.
1235    c$$$         IF(AX.LT.0)AL(4) = AL(4)+acos(-1.)        
1236    c$$$      ELSEIF(AX.EQ.0)THEN
1237    c$$$         AL(4) = acos(-1.)/2
1238    c$$$         IF(AY.LT.0)AL(4) = AL(4)+acos(-1.)
1239    c$$$      ENDIF
1240    c$$$      IF(AX.LT.0)AL(4)= acos(-1.)+ AL(4)
1241    c$$$      AL(4) = -acos(-1.) + AL(4) !from incidence direction to tracking ref.sys.
1242    
1243    c$$$      AL(4)=0.
1244    c$$$      IF( AX.NE.0.OR.AY.NE.0. ) THEN
1245    c$$$         AL(4) = ASIN(AY/SQRT(AX**2+AY**2))
1246    c$$$         IF(AX.LT.0.) AL(4) = ACOS(-1.0)-AL(4)
1247    c$$$      ENDIF
1248    
1249          AL(4)=0.
1250          IF( AX.NE.0.OR.AY.NE.0. ) THEN
1251             AL(4) = ASIN(AY/SQRT(AX**2+AY**2))
1252             IF(AX.LT.0.AND.AY.GE.0) AL(4) = ACOS(-1.0)-AL(4)
1253             IF(AX.LT.0.AND.AY.LT.0) AL(4) = -ACOS(-1.0)-AL(4)
1254          ENDIF
1255          IF(AY.GT.0.) AL(4) = AL(4)-ACOS(-1.0)
1256          IF(AY.LE.0.) AL(4) = AL(4)+ACOS(-1.0)
1257    
1258          AL(5) = DEF
1259    
1260    c      print*,' guess: ',(al(i),i=1,5)
1261    
1262          end

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

  ViewVC Help
Powered by ViewVC 1.1.23