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

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 backly
      
      implicit none
      include 'MID_REL_INCL:fit_var.inc'
      
                                ! keywords coming from line
      character*80 SPESYS,INPSYS,HISSYS,OUTSYS
      integer GRASYS
      INTEGER IDrun(10000)      ! ID of the fits to be executed


      integer ist,i,ijk,iok,nj,j,Nidrun,indx_i,indx_o
      integer TabID,i1,i2,i3,i4,icol(20)
      logical la
      character*80 filnam,sjunk

      
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('backly')
      
      call STKRDC('SPECTAB',1,1,80,i,SPESYS,ijk,ijk,iok) !Input spectrum
      if (iok.ne.0) then
         call ErrMsg('Error in reading keywords: check context..')
         call STSEPI() 
         stop
      end if   

      call STKRDC('INPUTC',1,1,20,i,INPSYS,ijk,ijk,iok) ! Input histtab
      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) !Output results
      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) !Output history
      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) !Graphics
      if (iok.ne.0) then
         call ErrMsg('Error in reading keywords: check context..')
         call STSEPI() 
         stop
      end if   

      

C!!!!!!!
C     Videata iniziale
C!!!!!!!
      call DisMsg('Loading data...')
      call DisMsg('Wait please..')
      
C!!!!!!!
C     Inizializzazione programma
C!!!!!!!
      call AtmRD(ist)            !read atompar.dat
      NPUNTI=NMXSPE
      call reaspe(SPESYS,NPUNTI)    !reads spectrum
      if (NPUNTI.lt.1) goto 666
                                ! reads input history to get IDrun
      indx_i=index(INPSYS,' ')
      filnam=INPSYS(1:indx_i-1)//PARTBL 
      call TBTOPN(filnam,F_IO_MODE,TabID,ist) !open table
      call TBLSER(TabID,'ID',icol(1),ist)


      i1=1                      !doesn't stop on errors
      i2=0
      i3=0
      call STECNT('PUT',i1,i2,i3)

      call TBIGET(TABID,i1,i2,i3,i4,nj,ist) !n. of rows

      j=0
      do i=1,nj
         call TBSGET(TABID,i,la,ist) ! selected?
         if (la) then
            call TBERDI(TABID,i,icol(1),j,la,ist) !reads element 
            IDrun(j) = j
         end if
      end do

      call TBTCLO(TABID,ist)

      Nidrun = j
c      write(sjunk,*)Nidrun
c      call sttdis(sjunk,0,ist)
c      do j=1,Nidrun
c         write(sjunk,*)idrun(j)
c         call sttdis(sjunk,0,ist)
c      end do

      indx_o=index(HISSYS,' ')       !Reads output history
      filnam=HISSYS(1:indx_o-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



C####
C     Main loop : executes minimizations
C####
      do j=1,Nidrun
         
         if (IDrun(j) .ne. 0 ) then
                                !reads from input history files
            filnam=INPSYS(1:indx_i-1)//PARTBL 
            call f_tblr(filnam,IDrun(j),ist)
            if (ist.ne.0) then
               call ErrMsg('Error in reading parameter table')
               call STSEPI()
               stop
            end if   
            filnam=INPSYS(1:indx_i-1)//MINTBL 
            call rminui(filnam,IDrun(j),ist)
            if (ist.ne.0) then
               call ErrMsg('Error in reading minuit command table')
               call STSEPI()
               stop
            end if   
            filnam=INPSYS(1:indx_i-1)//LIMTBL 
            call rintvl(filnam,IDrun(j),ist)
            if (ist.ne.0) then
               call ErrMsg('Error in reading interval table')
               call STSEPI()
               stop
            end if   
                  
            call f_tblw(PARTBL,1,ist) ! save on standard tables
            call ssetup(PARTBL,ist)
            call sminui(MINTBL,1,ist)
            call sintvl(LIMTBL,1,ist)
         

                                ! Executes minimization
            call FitWin(i,iok)  ! create data for FCN
            if (iok.lt.0) then
               call ErrMsg('Error in initial condition for fit')
               call STSEPI()
               stop
            end if
            call FCNHd()
            call MinuHd()
            call DisMsg('...Done')
c            write(sjunk,*)i
c            call sttdis(sjunk,0,ist)
            write(sjunk,'(a25,i6)')'Number of pixel selected:',i
            call sttdis(sjunk,0,ist)
            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(iok)
            call ShoRes

C       SAVE
            IDnum=IDNum+1
            call SavRes(OUTSYS,ist)
         
                                !saves on output history file 
            filnam=HISSYS(1:indx_o-1)//PARTBL
            call f_tblw(filnam,IDNum,ist)
         
            filnam=HISSYS(1:indx_o-1)//MINTBL
            call sminui(filnam,IDNum,ist)
         
            filnam=HISSYS(1:indx_o-1)//LIMTBL
            call sintvl(filnam,IDNum,ist)

            
            write(sjunk,'(a17,i6)')'Saved with ID =  ',IDnum
            call DisMsg(sjunk)
               

         end if

      end do


 666  continue
      call STSEPI()
      end


