C @(#)minmon.for 17.1.1.1 (ES0-DMD) 01/25/02 17:10:51 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