C @(#)lsqmsg.for 17.1.1.1 (ES0-DMD) 01/25/02 17:10:50 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 LSQMSG(METHOD,IFAIL) C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C.MODULE C FIT C C.NAME C LSQMSG C C.PURPOSE C Decode exit status from NAG LSQ routines and display appropriate C message. C C.KEYWORDS C Status message. C C.DESCRIPTION C trivial C C.LANGUAGE C FORTRAN C C.CALLING SEQUENCE C CALL LSQMSG(METHOD,IFAIL) C C.INPUT PARAMETERS C METHOD (*) CHARACTER method used C IFAIL INTEGER Exit status. 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 .. Scalar Arguments .. INTEGER IFAIL CHARACTER METHOD* (*) C .. C .. Local Scalars .. INTEGER ISTAT CHARACTER LINE*75 C .. C .. Executable Statements .. IF (IFAIL.EQ.0) THEN LINE = ' --> '//METHOD//' : Convergence achieved <--' ELSE IF (IFAIL.EQ.1) THEN LINE = '*** ERR-1-'//METHOD// + ' : Bad initializations ... Aborting ***' ELSE IF (IFAIL.EQ.2) THEN LINE = '*** WARN-2-'//METHOD// + ' : No convergence reached ***' ELSE IF (IFAIL.EQ.3) THEN LINE = '*** WARN-3-'//METHOD// + ' : Final parameters not really satisfory ***' ELSE IF (IFAIL.EQ.4) THEN LINE = '*** ERR-4-'//METHOD// + ' : No convergence in singular value decomposition ***' ELSE IF (IFAIL.EQ.5) THEN LINE = '*** WARN-5-'//METHOD// + ' : Final parameters only a good estimation ***' ELSE IF (IFAIL.EQ.9) THEN LINE = '*** ERR-'//METHOD// + ' : Likely an error in forming the derivatives ***' ELSE IF (IFAIL.GT.5) THEN WRITE (LINE,9000) IFAIL,METHOD END IF CALL STTPUT(LINE,ISTAT) IF (IFAIL.GT.4 .AND. IFAIL.LT.9) CALL STTPUT + (' suggest a retry with other initial values',ISTAT) RETURN 9000 FORMAT ('*** ERR-',I1,'-',A5,' : Final parameters are not satisf', + 'actory ***') END