C @(#)ftcomp.for	17.1.1.1 (ES0-DMD) 01/25/02 17:10:43
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
C @(#)ftcomp.for	4.1.1.2 (ESO-IPG) 12/1/92 17:17:44
      SUBROUTINE FTCOMP(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  FTCOMP.FOR
C                                                                               
C.PURPOSE                                                                       
C                                                                               
C  INTERFACE ROUTINES FOR THE FITTING STRUCTURES                                
C
C COMPUTE FITTED VALUES FOR THE DEFINED INDEPENDENT                             
C VARIABLES, RESULT ON THE DEFINED DEPENDENT VARIABLE                           
C                                                                               
C                                                                               
C.KEYWORDS                                                                      
C                                                                               
C  NON LINEAR FITTING                                                           
C                                                                               
C                                                                               
C----------------------------------------------------------------               
C                                                                               
C                                                                               
C      IMPLICIT NONE                                                            
C                                                                               

      INTEGER ICOL(2),NPIX(3),ISTAT,NCOL,NROW,NSC,I,IUNIT                                                   
      INTEGER NP1, NP2, NP3, NAC, NAR
      INTEGER MADRID(1)
       
      REAL STR(3),STP(3),CUT(4),VALUE(8)                                
      DOUBLE PRECISION RES(2),RES1(2)                                                   
      LOGICAL NULL(8),VALID,ISEL                                                
C
       INCLUDE 'MID_INCLUDE:FITI.INC/NOLIST'                                    
       INCLUDE 'MID_INCLUDE:FITC.INC/NOLIST'                                    
       COMMON/VMR/MADRID
C
      DATA NPIX/1,1,1/                                                          
C                                                                               
      DO 100 I=1,8
         NULL(I) = .FALSE.
100   CONTINUE
      IF (FZMAPPED.EQ.0) THEN                                                 
          ISTAT  = FERDAT                                                   
          RETURN                                                                
      END IF                                                                    
C                                                                               
C TABLE DATA                                                                    
C                                                                               
      IF (FZTYPE.EQ.'TBL ') THEN                                              
C                                                                               
C   READ GENERAL INFO AND SET UP OUTPUT COLUMNS                                 
C                                                                               
          CALL TBIGET(FZIDEN,NCOL,NROW,NSC,NAC,NAR,ISTAT)                             
          ICOL(1) = FZDVAR                                                    
          IF (FZWEIGHT.GT.0) THEN                                             
              NCOL   = 2                                                        
              ICOL(2) = FZWEIGHT                                              
          ELSE                                                                  
              NCOL   = 1                                                        
          END IF                                                                
C                                                                               
C   COMPUTE LOOP                                                                
C                                                                               
          DO 10 I = 1,NROW                                                      
              CALL TBSGET(FZIDEN,I,ISEL,ISTAT)                                
              CALL TBRRDR(FZIDEN,I,FZNIND,FZIVAR,VALUE,NULL,        
     +                    ISTAT)                                                
              VALID  = ISEL .AND. ( .NOT. NULL(1)) .AND.                        
     +                 ( .NOT. NULL(2)) .AND. ( .NOT. NULL(3))                  
              IF (VALID) THEN                                                   
                  CALL FTCVAL(FZIVAR,VALUE,RES)                               
                  RES1(1) = RES(1)                                              
                  RES1(2) = RES(2)                                              
                  CALL TBRWRD(FZIDEN,I,NCOL,ICOL,RES1,ISTAT)            
              END IF                                                            
                                                                                
   10     CONTINUE                                                              
C                                                                               
C RELEASE TABLE DATA                                                            
C                                                                               
          CALL TBSINI(FZIDEN,ISTAT)                                           
          CALL TBTCLO(FZIDEN,ISTAT)                                           
          FZMAPPED = 0                                                        
                                                                                
      ELSE                                                                      
C                                                                               
C IMAGE DATA                                                                    
C                                                                               
          IF (FZNAXIS.GT.3) THEN                                              
              CALL STTPUT('Max.no. of dim.exceded',ISTAT)                       
              RETURN                                                            
                                                                                
          END IF                                                                
                                                                                
          DO 20 I = 1,FZNAXIS                                                 
              NPIX(I) = FZNPIX(I)                                             
              STR(I)  = FZSTART(I)                                             
              STP(I)  = FZSTEP(I)                                              
   20     CONTINUE                                                              
          NP1 = NPIX(1)
          NP2 = NPIX(2)
          NP3 = NPIX(3)
          CALL FTCVA1(MADRID(FZPTRI),MADRID(FZPTRM),FZNAXIS,              
     +                NP1,NP2,NP3,FZSTART,FZSTEP,CUT)                          
          CALL STDWRR(FZIDEN,'LHCUTS',CUT,1,4,IUNIT,ISTAT)                      
          CALL STFCLO(FZIDEN,ISTAT)                                           
          FZMAPPED = 0                                                        
      END IF                                                                    
                                                                                
      RETURN                                                                    
                                                                                
      END