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

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

  ViewVC Help
Powered by ViewVC 1.1.23