C @(#)fttabl.for 17.1.1.1 (ES0-DMD) 01/25/02 17:10:47 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 FTTABL(NAME,DVAR,IVAR,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 INITIALIZE DATA STRUCTURE TO FIT TABLE DATA C VARIABLES ARE COLUMNS IN A TABLE C 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 INPUT PARAMETERS C NAME CHAR TABLE NAME C DVAR CHAR COLUMN ACTING AS DEPENDENT VARIABLE C AND OPTIONAL ERROR COLUMN C IVAR CHAR COLUMNS ACTING AS IND.VARS C C OUTPUT PARAMETERS C ISTAT INTG STATUS RETURN C INTEGER ISTAT,IND1,IND2,I,KZ6904 CHARACTER*(*) NAME,DVAR,IVAR CHARACTER*80 LINE,LINE1 CHARACTER*17 LAB1,LAB2 LOGICAL NEXT INCLUDE 'MID_INCLUDE:ST_DEF.INC' INCLUDE 'MID_INCLUDE:FITI.INC/NOLIST' INCLUDE 'MID_INCLUDE:FITC.INC/NOLIST' INCLUDE 'MID_INCLUDE:ST_DAT.INC' C C READ TABLE C CALL TBTOPN(NAME,F_IO_MODE,FZIDEN,ISTAT) C C LAB1 CONTAINS THE COLUMN ACTING AS DEP VAR C LAB2 OPTIONAL WEIGHT C IND1 = INDEX(DVAR,',') IND2 = INDEX(DVAR,' ') IF (IND1.EQ.0) THEN LAB1 = DVAR(1:IND2-1) LAB2 = ' ' ELSE LAB1 = DVAR(1:IND1-1) LAB2 = DVAR(IND1+1:IND2-1) END IF CALL TBCSER(FZIDEN,LAB1,FZDVAR,ISTAT) IF (FZDVAR.EQ.-1) THEN ISTAT = FERPAR RETURN END IF IF (LAB2(1:1).EQ.' ') THEN FZWEIGHT = 0 ELSE CALL TBCSER(FZIDEN,LAB2,FZWEIGHT,ISTAT) IF (FZWEIGHT.EQ.-1) THEN ISTAT = FERPAR RETURN END IF END IF C C DECODE INDEPENDENT VARIABLES C IND2 = INDEX(IVAR,' ') - 1 LINE = IVAR(1:IND2)//',,' IND2 = INDEX(LINE,',') - 1 NEXT = .TRUE. FZNIND = 0 KZ6904 = 0 99 KZ6904 = KZ6904 +1 IF ( .NOT. (NEXT)) GO TO 20 C C LAB1 CONTAINS NEXT LABEL C LAB1 = LINE(1:IND2) LINE1 = LINE(IND2+2:) LINE = LINE1 FZNIND = FZNIND + 1 CALL TBCSER(FZIDEN,LAB1,FZIVAR(FZNIND),ISTAT) IF (FZIVAR(FZNIND).EQ.-1) THEN ISTAT = FERPAR RETURN END IF IND2 = INDEX(LINE,',') - 1 NEXT = IND2 .NE. 0 GOTO 99 20 CONTINUE C C INITIALIZE VARIABLES IN THE COMMON AREA C FZNAME = NAME FZTYPE = 'TBL ' FZNFUN = 0 FZNDAT = 0 FZNPTOT = 0 FZNITER = 0 FZRELAX = 0. FZCHISQ = 0. FZCCHIS = 0. DO 30 I = 1,FZFUNMAX FZFCODE(I) = 0 FZACTPAR(I) = 0 FZSPEC(I) = ' ' 30 CONTINUE DO 40 I = 1,FZPARMAX FZERROR(I) = 0.D0 FZVALUE(I) = 0.D0 FZGUESS(I) = 0.D0 FZUNCER(I) = 0. FZFIXED(I) = -1 40 CONTINUE FZMAPPED = 1 RETURN END