C @(#)ftddvi.for 17.1.1.1 (ESO-DMD) 01/25/02 17:10:44 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 FTDDVI(NAME,MASK,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 DEFINE NEW DEPENDENT VARIABLE FOR OUTPUT C DEPENDENT VARIABLE IS THE IMAGE DATA C INDEPENDENT VARIABLES ARE IMAGE AXES ALREADY DEFINED 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 IMAGE NAME C MASK CHAR OPTIONAL WEIGHTING MASK C BLANKS IF NOT USED C C OUTPUT PARAMETERS C ISTAT INTG STATUS RETURN C IMPLICIT NONE CHARACTER*(*) NAME,MASK CHARACTER UNIT*72,IDENT*72 INTEGER ISTAT, J, IPTR DOUBLE PRECISION DSTART(8), DSTEP(8) C INCLUDE 'MID_INCLUDE:ST_DEF.INC/NOLIST' INCLUDE 'MID_INCLUDE:FITI.INC/NOLIST' INCLUDE 'MID_INCLUDE:FITC.INC/NOLIST' INCLUDE 'MID_INCLUDE:ST_DAT.INC/NOLIST' C C CREATE OPTIONAL MASK C UNIT = ' ' IF (MASK(1:1).EQ.' ') THEN FZPTRM = 0 ELSE IDENT = ' WEIGHT MASK ' DO 5 J = 1, FZNAXIS DSTART(J) = FZSTART(J) DSTEP(J) = FZSTEP(J) 5 CONTINUE CALL STIPUT(MASK,D_R4_FORMAT,F_O_MODE,F_IMA_TYPE, . FZNAXIS,FZNPIX,DSTART,DSTEP,IDENT, . UNIT,IPTR,FZIDEN,ISTAT) C CALL SXIPUT(MASK,'O',FZNAXIS,FZNPIX,FZSTART,FZSTEP, C + IDENT,UNIT,IPTR,ISTAT) FZPTRM = IPTR END IF C C WRITE IMAGE C IDENT = ' FITTED IMAGE' C CALL SXIPUT(NAME,'O',FZNAXIS,FZNPIX,FZSTART,FZSTEP,IDENT, C + UNIT,IPTR,ISTAT) DO 10 J = 1, FZNAXIS DSTART(J) = FZSTART(J) DSTEP(J) = FZSTEP(J) 10 CONTINUE CALL STIPUT(NAME,D_R4_FORMAT,F_O_MODE,F_IMA_TYPE, . FZNAXIS,FZNPIX,DSTART,DSTEP,IDENT, . UNIT,IPTR,FZIDEN,ISTAT) FZPTRI = IPTR C C CHANGE VARIABLES IN THE COMMON AREA C FZNAME = NAME FZTYPE = 'BDF ' FZMAPPED = 1 RETURN END