C===========================================================================
C Copyright (C) 1995,2004 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 Massachusetts Ave, Cambridge, 
C MA 02139, USA.
C
C Correspondence 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
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.COPYRIGHT: Copyright (c) 1987,2004 European Southern Observatory,
C                                         all rights reserved
C
C.VERSION: 1.0  ESO-FORTRAN Conversion, AA  15:25 - 20 DEC 1987
C
C.LANGUAGE: F77+ESOext
C
C.AUTHOR: J.D.PONZ
C
C.IDENTIFICATION
C
C  program FITCREA.FOR
C
C.PURPOSE
C
C  Execute the commands
C  COMP/FIT image[,error] [= array[(refima)]]
C  COMP/FIT table dvar[,error] [= array[(in.var)]]
C
C.KEYWORDS
C
C  FIT
C
C.INPUT/OUTPUT
C
C  P1 - P8     contain input parameters
C
C.ALGORITHM
C
C  Use fit interface routines
C
C.VERSION
C 040521	last modif
C 
C-----------------------------------------------------------
C
C
C ... define parameters
C
      IMPLICIT   NONE
C
      INTEGER    KUN,KNUL,ISTAT,IND,INDEX
      INTEGER    I,II,II1,HLEN,NAMLEN,IMNOC
C
      CHARACTER*80 NAME,FILE,MASK
      CHARACTER    IAC*1
      CHARACTER    LINE1*34,LINE2*80,REFIMA*80,HISTORY*160
      CHARACTER*80 P1,P2,P3,P4,FTABLE
      CHARACTER*82 LINE
C
      INCLUDE  'MID_INCLUDE:ST_DEF.INC'
      INCLUDE  'MID_INCLUDE:FITI.INC'
      INCLUDE  'MID_INCLUDE:FITC.INC'
      INCLUDE  'MID_INCLUDE:ST_DAT.INC'
C
      DATA NAMLEN/80/
C
C ... get into MIDAS
C
      CALL STSPRO('FITCREA')
      CALL FITBL
      HISTORY(1:) = 'COMPUTE/FIT '
      CALL STKRDC('P1',1,1,80,I,P1,KUN,KNUL,ISTAT)
      I = INDEX(P1,' ')
      HISTORY(13:) = P1(1:I)//' '
      HLEN = I + 15
      CALL STKRDC('P2',1,1,80,I,P2,KUN,KNUL,ISTAT)
      I = INDEX(P2,' ')
      II = HLEN + I + 2
      IF (II .LE. 160) THEN
         HISTORY(HLEN:) = P2(1:I)//' '
         HLEN = II
      ENDIF
      CALL STKRDC('P3',1,1,80,I,P3,KUN,KNUL,ISTAT)
      I = INDEX(P3,' ')
      II = HLEN + I + 2
      IF (II .LE. 160) THEN
         HISTORY(HLEN:) = P3(1:I)//' '
         HLEN = II
      ENDIF
      CALL STKRDC('P4',1,1,80,I,P4,KUN,KNUL,ISTAT)
      I = INDEX(P4,' ')
      II = HLEN + I + 2
      IF (II .LE. 160) THEN
         HISTORY(HLEN:) = P4(1:I)//' '
         HLEN = II
      ENDIF
C 
      IF (P2(1:1).EQ.':' .OR. P2(1:1).EQ.'#') THEN
          P3     = '='
      ELSE
          P2     = '='
      END IF  
C 
      IF (P2(1:1).EQ.'=') THEN                            !   IMAGE
          FTABLE = P1
          IAC    = 'I'
          II     = INDEX(P1,',')
          IF (II.EQ.0) THEN
              FILE   = P1
              MASK   = ' '
          ELSE
              FILE   = P1(1:II-1)
              MASK   = P1(II+1:)
          END IF
          II     = INDEX(P3,'(')
          IF (II.EQ.0) THEN
              NAME   = P3
              REFIMA = '?'
          ELSE
              NAME   = P3(1:II-1)
              LINE   = P3//')'
              II1    = INDEX(LINE,')')
              REFIMA = P3(II+1:II1-1)
          END IF 
      ELSE                                                !   TABLE
          IND    = INDEX(P1,' ') - 1
          FTABLE = P1(1:IND)//'.TBL'
          IAC    = 'T'
          FILE   = P1
          LINE1  = P2
          II     = INDEX(P4,'(')
          IF (II.EQ.0) THEN
              NAME   = P4
              LINE2  = '?'
          ELSE
              NAME   = P4(1:II-1)
              LINE   = P4//')'
              II1    = INDEX(LINE,')')
              LINE2  = P4(II+1:II1-1)
          END IF
      END IF
      IF (NAME(1:1).EQ.'?') THEN
          CALL STKRDC('FITNAME',1,1,NAMLEN,I,NAME,KUN,KNUL,ISTAT)
      ELSE
          CALL STKWRC('FITNAME',1,NAME,1,NAMLEN,KUN,ISTAT)
      END IF
C
C ... read computed parameters
C
      CALL FTINIT(NAME,ISTAT)
C
C ... modify independent variables if required
C     and define dependent variables
C
      IF (IAC.EQ.'I') THEN
          IF (REFIMA(1:1).NE.'?') CALL FTDIVI(REFIMA,ISTAT)
          CALL FTDDVI(FILE,MASK,ISTAT)
      ELSE
          IF (LINE2(1:1).NE.'?') CALL FTDIVT(FILE,LINE2,ISTAT)
          CALL FTDDVT(FILE,LINE1,ISTAT)
      END IF
      CALL FTCOMP(ISTAT)
C 
      IF (IAC.EQ.'I') THEN
         CALL STFOPN(FILE,D_OLD_FORMAT,0,F_OLD_TYPE,IMNOC,ISTAT)
         IF (HLEN .LT. 81) THEN
            HLEN = 80
         ELSE
            HLEN = 160
         ENDIF
         CALL STDWRC(IMNOC,'HISTORY',1,HISTORY,1,HLEN,KUN,ISTAT)
      ENDIF

C
C ... end
C
      CALL STSEPI
9000  FORMAT (I4)
      END
      
