C @(#)fitdirect.for	19.1 (ESO-IPG) 02/25/03 13:28:04

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


      program fitdirect
      
      implicit none
      include 'MID_REL_INCL:fit_var.inc'
      
                                ! copies of keywords coming from line
      character*80 SPESYS,SESSYS,OUTSYS,HISSYS
      integer GRASYS


      character*30 choice
      character*70 sjunk
      character*60 filnam


      integer ifla,ist,i,ijk,iok

C      include 'MID_REL_INCL:fit_mid.inc'
        INTEGER MADRID(1)
        INCLUDE 'MID_INCLUDE:ST_DEF.INC'

        COMMON/VMR/MADRID

        INCLUDE 'MID_INCLUDE:ST_DAT.INC'

C!!!!!!!
C     MIDAS SET-UP
C!!!!!!!
      call STSPRO('fitdirect')
      
      call STKRDC('SPECTAB',1,1,80,i,SPESYS,ijk,ijk,iok)
      if (iok.ne.0) then
         call ErrMsg('Error in reading keywords: check context..')
         call STSEPI() 
         stop
      end if   
      call STKRDC('OUTTAB',1,1,80,i,OUTSYS,ijk,ijk,iok)
      if (iok.ne.0) then
         call ErrMsg('Error in reading keywords: check context..')
         call STSEPI() 
         stop
      end if   
      call STKRDC('HISTAB',1,1,80,i,HISSYS,ijk,ijk,iok)
       if (iok.ne.0) then
         call ErrMsg('Error in reading keywords: check context..')
         call STSEPI() 
         stop
      end if   
      call STKRDC('SESSNAM',1,1,80,i,SESSYS,ijk,ijk,iok)
      if (iok.ne.0) then
         call ErrMsg('Error in reading keywords: check context..')
         call STSEPI() 
         stop
      end if   
      call STKRDI('GRAWIN',1,1,i,GRASYS,ijk,ijk,iok)
      if (iok.ne.0) then
         call ErrMsg('Error in reading keywords: check context..')
         call STSEPI() 
         stop
      end if   


C!!!!!!!
C     Videata iniziale
C!!!!!!!
      choice = ' '
      do i=1,4
         call sttdis(choice,0,ist)
      end do
      
      sjunk = '      - FitLyman-   Lyman clouds fitting procedure'
      do i=1,2
         call sttdis(' ',0,ist)
      end do
      call DisMsg('Loading & initializing data...')
      call DisMsg('Wait please..')
      
C!!!!!!!
C     Inizializzazione programma
C!!!!!!!
      if (SESSYS.ne.'NULL') then
         i=index(SESSYS,' ')
         sjunk=SESSYS(1:i-1)//PARTBL
      else
         sjunk=PARTBL
      end if
      call rsetup(sjunk,ist)  ! read set-up 

      if (ist.ne.0) then        ! on error, default values
         call WrnMsg('Error in reading set-up: using defaults')
                                ! copy syskeys into variables
         if (SPESYS.ne.'NULL') then
            FILSPE=SPESYS
         else
           call ErrMsg('Missing input parameters: check line command')
           call STSEPI() 
           stop
         end if   

         if (OUTSYS.ne.'NULL') then
            FILOUT=OUTSYS
         else
           call ErrMsg('Missing input parameters: check line command')
           call STSEPI() 
           stop
         end if   

         if (HISSYS.ne.'NULL') then
            FILLOG=HISSYS
         else
           call ErrMsg('Missing input parameters: check line command')
           call STSEPI() 
           stop
         end if   
         
         TURBLN=0
         i_grap = .false.
         if (GRASYS.ne.0) i_grap = .true.

         call F_TBLR('SCRATCH',1,ist) !initializes lypar (in memory!)

      else

         call f_tblr(sjunk,1,ist) !read init. param.
         if (SPESYS.ne.'NULL') FILSPE=SPESYS ! overrides values read
         if (OUTSYS.ne.'NULL') FILOUT=OUTSYS
         if (HISSYS.ne.'NULL') FILLOG=HISSYS
         if (GRASYS.ne.-1) then
            if (GRASYS .eq.1) i_grap = .true.
            if (GRASYS .eq.0) i_grap = .false.
         end if

      end if

      call f_tblw(PARTBL,1,ist)
c     call AskStp('PROGRAM',ist)
      call ssetup(PARTBL,ist)
      if (ist.ne.0) then
         call ErrMsg('Error in writing set-up: check disk space')
         call STSEPI() 
         stop
      end if   

      call AtmRD(ist)            !read atompar.dat
      NPUNTI=NMXSPE
      call reaspe(FILSPE,NPUNTI)    !read spectrum
      if (NPUNTI.lt.1) goto 666      
      i=index(FILLOG,' ')
      filnam=fillog(1:i-1)//PARTBL
      call GETIDN(filnam,IDnum,ist) 
      if (ist.ne.0) then
         call WrnMsg('Log files not found: starting from scratch')
         IDnum=0
      end if
                                ! read fit limits
      if (SESSYS.ne.'NULL') then
         i=index(SESSYS,' ')
         sjunk=SESSYS(1:i-1)//LIMTBL
      else
         sjunk=LIMTBL
      end if   
      call rintvl(sjunk,1,ist)  
      call sintvl(sjunk,1,ist) 

                                ! read minuit instructions
      if (SESSYS.ne.'NULL') then
         i=index(SESSYS,' ')
         sjunk=SESSYS(1:i-1)//MINTBL
      else
         sjunk=MINTBL
      end if   
      call rminui(sjunk,1,ist) 
      call sminui(sjunk,1,ist)


      call GraMai(ist)          ! plot 


      call DisMsg('        ..done')
      call sttdis(' ',0,ist)
      

C####
C    DIRECTMINI
C####
      call DisMsg('Preparing minimization data...')
      
      call f_tblr(PARTBL,1,ifla)
      if (ifla.ne.0) then
         call ErrMsg('Error in reading lypar')
         call STSEPI()
         stop
      end if               
                       
      call rintvl(LIMTBL,1,ifla)
      if (ifla.ne.0)  then
         call ErrMsg('Error in reading lypar')
         call STSEPI()
         stop
      end if
      
      call rminui(MINTBL,1,ifla)
      if (ifla.ne.0)  then
         call ErrMsg('Error in reading lypar')
         call STSEPI()
         stop
      end if
      
      call FitWin(i,ifla)       ! create data for FCN
      if (ifla.lt.0) then
         call ErrMsg('Error in initial condition for fit')
         call STSEPI()
         stop
      end if
      call FCNHd()
      call MinuHd()
      call DisMsg('...Done')
      write(sjunk,'(a25,i6)')'Number of pixel selected:',i
      call DisMsg(sjunk)

C       Esegue il fit
      call DisMsg('Executing fitting procedures...')
      call Minmze()
      call DisMsg('...Done')
      
C       Presenta e salva i risultati
      call GraMai(ifla)
      call ShoRes

      
      IDnum=IDNum+1
      call SavRes(FILOUT,ist)
      
      i=index(FILLOG,' ')       !saves on history file 
      filnam=FILLOG(1:i-1)//PARTBL
      call f_tblw(filnam,IDNum,ist)
      
      filnam=FILLOG(1:i-1)//MINTBL
      call sminui(filnam,IDNum,ist)
      
      filnam=FILLOG(1:i-1)//LIMTBL
      call sintvl(filnam,IDNum,ist)
      
            
      write(sjunk,'(a17,i6)')'Saved with ID =  ',IDnum
      call DisMsg(sjunk)

 666  continue
      call STSEPI()
      
      end
      











