C @(#)ftdodo.for 17.1.1.1 (ES0-DMD) 01/25/02 17:10:45 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 FTDODO(NITER,RELAX,CHISQ,V1,V2,NACT,ACTCH,ISTAT) C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C.COPYRIGHT: Copyright (c) 1987 European Southern Observatory, C all rights reserved C C.VERSION: 1.0 ESO-FORTRAN Conversion, AA 17:25 - 13 JAN 1988 C C.LANGUAGE: F77+ESOext C C.AUTHOR: J.D.PONZ C C.IDENTIFICATION C C FITLIB.FOR VERSION 1.0 27 MAR 1984 C C.PURPOSE C C INTERFACE ROUTINES FOR THE FITTING STRUCTURES C C ITERATE ON THE FITTING PROCESS C THE ITERATION IS FINISHED IF C - NITER IS REACHED OR C - CHISQ IS REACHED C - CONVERGENCE IS ACHIEVED C.ALGORITHM C C USE MIDAS I/O INTERFACES TO FRAMES AND TABLES C C.KEYWORDS C C NON LINEAR FITTING C C C---------------------------------------------------------------- C C C IMPLICIT NONE C INPUT PARAMETERS C NITER INTG NO. OF ITERATIONS TO BE DONE C RELAX REAL RELAXATION FACTOR C CHISQ REAL CHI SQUARE C V1,V2 REAL OPTIONAL FITTING INTERVAL (IF V1.NE.V2) C C OUTPUT PARAMETERS C NACT INTG ACTUAL NUMBER OF ITERATIONS C ACTCH REAL ACTUAL CHI SQ. C ISTAT INTG STATUS RETURN C LOGICAL NAG INTEGER MADRID(1) INTEGER KUN,KNUL,NITER,ISTAT,STATUS,NACT,K REAL RELAX,CHISQ,V1,V2,ACTCH CHARACTER*8 KEYMM CHARACTER*12 FZMETHOD INCLUDE 'MID_INCLUDE:FITI.INC/NOLIST' INCLUDE 'MID_INCLUDE:FITC.INC/NOLIST' COMMON/VMR/MADRID DATA KEYMM/'FITCHAR'/ C C BRANCH ON IMAGE OR TABULAR DATA C CALL STKRDC(KEYMM,1,FZIMET,6,K,FZMETHOD,KUN,KNUL,STATUS) C CALL SXKGET(KEYMM,'C',FZIMET,6,K,FZMETHOD,STATUS) CALL FORUPC(FZMETHOD,FZMETHOD) NAG = (FZMETHOD(1:5).EQ.'CGNND') .OR. + (FZMETHOD(1:2).EQ.'QN') .OR. (FZMETHOD(1:3).EQ.'MGN') IF ((.NOT.NAG) .AND. (FZMETHOD(1:2).NE.'NR')) . CALL STETER(3,'FIT : Error in method name') IF (NAG) THEN CALL FITNAG(FZMETHOD,ISTAT) ELSE IF (FZTYPE.EQ.'TBL ') THEN CALL FTTNTR(NITER,RELAX,CHISQ,V1,V2,NACT,ACTCH,ISTAT) ELSE CALL FTINTR(MADRID(FZPTRI),MADRID(FZPTRM),FZNPIX(1), + FZNPIX(2),FZNPIX(3),NITER,RELAX,CHISQ,V1, + V2,NACT,ACTCH,ISTAT) END IF END IF RETURN END