C @(#)ftspar.for 17.1.1.1 (ES0-DMD) 01/25/02 17:10:46 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 FTSPAR(PARM1,LEN,ISEQ,ITYPE) 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 SEARCHS FOR PARAMETER PARAM C RETURNS THE FUNCTION NUMBER AND THE TYPE OF PARAMETER 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 ARGUMENTS C PARM1 CHAR PARAMETER NAME C LEN INTG PARAMETER LENGTH C C OUTPUT ARGUMENTS C ITYPE INTG PARAMETER TYPE : 1 - Y VALUE C 2 - X VALUE C 3 - FWHM VALUE C -1 - PARAMETER WITH CONSTRAIN C 0 - UNKNOWN TYPE OR PARAM NOT FOUND C INTEGER LEN,ISEQ,ITYPE,I,J,IOFF,IFUN CHARACTER*(*) PARM1 CHARACTER*12 NAME CHARACTER*40 PARAM INCLUDE 'MID_INCLUDE:FITI.INC/NOLIST' INCLUDE 'MID_INCLUDE:FITC.INC/NOLIST' C C SEARCH FOR PARAMETER C PARAM = PARM1 CALL FORUPC(PARAM,PARAM) ITYPE = 0 DO 10 I = 1,FZNPTOT NAME = FZPTOKEN(I) CALL FORUPC(NAME,NAME) IF (NAME(1:FZPLEN(I)).EQ.PARAM(1:LEN)) GO TO 20 10 CONTINUE RETURN C C CHECK TYPE C 20 IF (FZFIXED(I).LT.0) THEN ITYPE = -1 ELSE IOFF = 0 DO 30 J = 1,FZNFUN IF (I.LE.IOFF+FZACTPAR(J)) THEN ITYPE = I - IOFF IFUN = FZFCODE(J) GO TO 40 END IF IOFF = IOFF + FZACTPAR(J) 30 CONTINUE 40 IF (IFUN.LE.1 .OR. IFUN.GE.24) ITYPE = 0 END IF RETURN END