C @(#)minmon.for	19.1 (ES0-DMD) 02/25/03 13:17:42
C===========================================================================
C Copyright (C) 1995 European Southern Observatory (ESO)
C
C This program is free software; you can redistribute it and/or 
C modify it under the terms of the GNU General Public License as 
C published by the Free Software Foundation; either version 2 of 
C the License, or (at your option) any later version.
C
C This program is distributed in the hope that it will be useful,
C but WITHOUT ANY WARRANTY; without even the implied warranty of
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C GNU General Public License for more details.
C
C You should have received a copy of the GNU General Public 
C License along with this program; if not, write to the Free 
C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
C MA 02139, USA.
C
C Corresponding concerning ESO-MIDAS should be addressed as follows:
C	Internet e-mail: midas@eso.org
C	Postal address: European Southern Observatory
C			Data Management Division 
C			Karl-Schwarzschild-Strasse 2
C			D 85748 Garching bei Muenchen 
C			GERMANY
C===========================================================================
C
      SUBROUTINE MINMON(NRPRM,PRM,FCT,GRD,ISTATE,GPJNRM,COND,POSDEF,            
     +                  ITER,NFEVAL,IW,LIW,W,LW)                                
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++        
C                                                                               
C.MODULE                                                                        
C       FIT                                                                     
C                                                                               
C.NAME                                                                          
C       MINMON                                                                  
C                                                                               
C.PURPOSE                                                                       
C       Monitoring the least squares algorithms.                                
C                                                                               
C.KEYWORDS                                                                      
C       Monitoring.                                                             
C                                                                               
C.DESCRIPTION                                                                   
C       trivial                                                                 
C                                                                               
C.LANGUAGE                                                                      
C       FORTRAN                                                                 
C                                                                               
C.CALLING SEQUENCE                                                              
C       CALL  MINMON(NRPRM,PRM,FCT,GRD,ISTATE,GPJNRM,COND,                      
C     +                 POSDEF,NRITER,NFEVAL,IW,LIW,W,LW)                       
C                                                                               
C.INPUT PARAMETERS                                                              
C       NRPRM               INTEGER  Number of parameters                       
C       PRM (NRPRM)         DOUBLE   Parameters                                 
C       FCT                 DOUBLE   Sum of residuals                           
C       GRD (NRPRM)         DOUBLE   values of the gradient                     
C       ISTATE (NRPRM)      INTEGER  Status of the param.                       
C       GPJNRM              DOUBLE   Norm of Proj. Gradient                     
C       COND                DOUBLE   Condition number of hessian                
C       POSDEF              LOGICAL  Positiveness of Hessian                    
C       NRITER              INTEGER  Iteration number                           
C       NFEVAL              INTEGER  Actual number of F. Eval.                  
C       IW (LIW)            INTEGER  unused                                     
C       LIW                 INTEGER                                             
C       W (LW)              DOUBLE                                              
C       LW                  INTEGER                                             
C                                                                               
C.MODIFIED PARAMETERS                                                           
C       none                                                                    
C                                                                               
C.OUTPUT PARAMETERS                                                             
C       none                                                                    
C                                                                               
C.FILES                                                                         
C       none                                                                    
C                                                                               
C.MODULES CALLED                                                                
C       STTPUT                                                                  
C                                                                               
C.AUTHOR                                                                        
C       Ph. DEFERT,      Feb 1986                                               
C                                                                               
C.MODIFICATIONS                                                                 
C                                                                               
C                                                                               
C-----------------------------------------------------------------------        
C      IMPLICIT NONE                                                            
C     ..                                                                        
C     .. Scalar Arguments ..                                                    
      INTEGER LIW,LW,NFEVAL,ITER,NRPRM                                          
      DOUBLE PRECISION GPJNRM,COND,FCT                                          
      LOGICAL POSDEF                                                            
C     ..                                                                        
C     .. Array Arguments ..                                                     
      DOUBLE PRECISION PRM(NRPRM),GRD(NRPRM),W(LW)                              
      INTEGER IW(LIW),ISTATE(NRPRM)                                             
C     ..                                                                        
C     .. Local Scalars ..                                                       
      INTEGER I,STATUS,ISJ                                                      
      DOUBLE PRECISION CHIOLD,REDCHI,PERDEC                                     
C     ..                                                                        
C     .. Local Arrays ..                                                        
      CHARACTER LINE*78                                                         
      CHARACTER*11 STAT(4)                                                      
C     ..                                                                        
C     .. Initializations ..                                                     
      INCLUDE 'MID_INCLUDE:FITNAGI.INC/NOLIST'                                 
      INCLUDE 'MID_INCLUDE:FITNAGC.INC/NOLIST'                                 
      SAVE REDCHI

      DATA STAT/'Free       ','Upper Bound','Lower Bound','Constant   '/        
      DATA REDCHI/1.D15/

CC      DATA CHIOLD/1.D15/                                                        
C     ..                                                                        
C     .. External Files ..                                                      
C     ..                                                                        
C     .. Executable Statements ..                                               
      CHIOLD = REDCHI                                                           
      REDCHI = DMAX1(FCT/DBLE(NRDATA-NRPRM+NRPFIX),0.D0)                      
      IF (ITER.GT.1 .AND. CHIOLD.GT.1.D-15) THEN                                
          PERDEC = 100.* (CHIOLD-REDCHI)/CHIOLD                                 
      ELSE                                                                      
          PERDEC = 0.                                                           
      END IF                                                                    
      CALL STTPUT(' ',STATUS)                                                   
      CALL STTPUT(                                                              
     +           ' Iter  F. Eval.  Sum of Squares  Red. Chisq.  % Decr.'        
     +            //'  Prj. Grad. Norm.',STATUS)                                
      WRITE (LINE,9000) ITER,NFEVAL,FCT,REDCHI,PERDEC,GPJNRM                    
      CALL STTPUT(LINE,STATUS)                                                  
      CALL STTPUT(' ',STATUS)                                                   
      CALL STTPUT('        Parameters       Gradient    '//'Status',            
     +            STATUS)                                                       
      DO 10 I = 1,NRPRM                                                         
          IF (ISTATE(I).GT.0) THEN                                              
              ISJ    = 1                                                        
          ELSE                                                                  
              ISJ    = ABS(ISTATE(I)) + 1                                       
          END IF                                                                
          WRITE (LINE,9010) PRM(I),GRD(I),STAT(ISJ)                             
          CALL STTPUT(LINE,STATUS)                                              
   10 CONTINUE                                                                  
      CALL STTPUT(' ',STATUS)                                                   
      IF (COND.LT.1.D-9) RETURN                                                 
      IF (COND.LT.1.D+6) THEN                                                   
          WRITE (LINE,9020) COND                                                
          CALL STTPUT(LINE,STATUS)                                              
      ELSE                                                                      
          CALL STTPUT(                                                          
     +          'Estimated Condition Number of the Projected Hessian is'        
     +                //' more than 10**6',STATUS)                              
      END IF                                                                    
      IF ( .NOT. POSDEF) CALL STTPUT(                                           
     +          ' Projected Hessian Matrix is not Positive Definite ...'        
     +                               ,STATUS)                                   
                                                                                
      RETURN                                                                    
 9000 FORMAT (I5,2X,I5,3X,1PE12.4,4X,1PE12.4,2X,0PF6.2,5X,1PE9.1)               
 9010 FORMAT (2X,1PD15.7,6X,1PD9.1,6X,A11)                                      
 9020 FORMAT ('Estimated Condition Number of the Projected Hessian',            
     +       ' is ',1PD10.3)                                                    
      END                                                                       
