C @(#)setup.for	10.1 (ESO-IPG) 2/9/96 13:56:59
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

C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        SUBROUTINE SSETUP(TblNam,IER)
C
C     
C       Saves the system parameters on the descriptors 
C       of the table
C     Onerror in creating the table,  ier=1
C     otherwise ier=0
C
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        implicit none

        character*(*) TblNam
        integer ier

        include 'MID_REL_INCL:fit_var.inc'

        integer i1,i2,i3,i
        integer TabID,ist
        CHARACTER*20 CDESCN(50)
        CHARACTER*20 IDESCN(50)
        CHARACTER*20 RDESCN(50)
        CHARACTER*20 appogg

        integer NIDESC,NCDESC,nrdesc

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'

        CDESCN(1)='SPECTRUMTABLE'
        CDESCN(2)='OUTTAB'
        CDESCN(3)='LOGNAME'
        CDESCN(4)='GRALAB'
        CDESCN(5)='ZPLOT'
        NCDESC=5

        IDESCN(1)='TURBOLENCE'
        IDESCN(2)='GRAPHWIN'
        IDESCN(3)='I_MINOS'
        IDESCN(4)='GCOLOR'
        IDESCN(5)='I_RESIDUALS'
        IDESCN(6)='I_STDEV'
        IDESCN(7)='GREGION'
        NIDESC=7

        RDESCN(1)='LAMBDA_LIM'
        RDESCN(2)='COLDEN_LIM'
        RDESCN(3)='BTEMP_LIM'
        RDESCN(4)='BTURB_LIM'
        RDESCN(5)='GRAPH_BOTTOM'
        RDESCN(6)='GRAPH_TOP'
        RDESCN(7)='GRAPH_MIN'
        RDESCN(8)='GRAPH_MAX'
        RDESCN(9)='GRAPH_STEP'
        RDESCN(10)='GRAPH_LABEL'
        RDESCN(11)='GRAPH_TICK'
        RDESCN(12)='REDSHIFT'
        RDESCN(13)='VELRANGE'
        NRDESC=13

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

        call TBTOPN(TblNam,F_IO_MODE,TabID,ist)   !open
        if (ist .ne. 0 ) then       ! if it doesn't exist, create
           ier=1
           return
        end if

        do i=1,NCDESC           ! delete descriptors
           call STDDEL(TabID,CDESCN(i),IST)
        end do
        do i=1,NIDESC
           call STDDEL(TabID,IDESCN(i),IST)
        end do
        do i=1,NRDESC
           call STDDEL(TabID,RDESCN(i),IST)
        end do

        call STDWRC(TabID,CDESCN(1),1,FILSPE,1,60,I1,ist)
        call STDWRC(TabID,CDESCN(2),1,FILOUT,1,60,I1,ist)
        call STDWRC(TabID,CDESCN(3),1,FILLOG,1,60,I1,ist)
        if (NREGIO.gt.0) then
           do i=1,NREGIO
              write(appogg,'(a6,i2.2)')CDESCN(4),i
              call STDWRC(TabID,appogg,1,LLABEL(i),1,60,I1,ist)
           end do
        end if
c        call STDWRC(TabID,CDESCN(4),1,FILLOG,1,60,I1,ist)
        if (I_Z) then
           call STDWRC(TabID,CDESCN(5),1,'TRUE',1,60,I1,ist)
        else
           call STDWRC(TabID,CDESCN(5),1,'FALSE',1,60,I1,ist)
        endif
        call STDWRI(TabID,IDESCN(1),TURBLN,1,1,I1,ist)
        I2=0
        IF (I_GRAP) I2=1
        call STDWRI(TabID,IDESCN(2),I2,1,1,I1,ist)
        call STDWRI(TabID,IDESCN(3),IMINOS,1,1,I1,ist)
        call STDWRI(TabID,IDESCN(4),GCOLOR,1,7,I1,ist)
        I2=0
        IF (I_RESD) I2=1
        call STDWRI(TabID,IDESCN(5),I2,1,1,I1,ist)
        I2=0
        IF (I_VAR) I2=1
        call STDWRI(TabID,IDESCN(6),I2,1,1,I1,ist)
        call STDWRI(TabID,IDESCN(7),NREGIO,1,1,I1,ist)

        call STDWRD(TabID,RDESCN(1),LAMLIM,1,3,I1,ist)
        call STDWRD(TabID,RDESCN(2),NLIM,1,3,I1,ist)
        call STDWRD(TabID,RDESCN(3),BLIM,1,3,I1,ist)
        call STDWRD(TabID,RDESCN(4),BTULIM,1,3,I1,ist)
        call STDWRD(TabID,RDESCN(5),GR_BOT,1,1,I1,ist)
        call STDWRD(TabID,RDESCN(6),GR_TOP,1,1,I1,ist)
        if (NREGIO.gt.0) then
           call STDWRD(TabID,RDESCN(7),REGMIN,1,NREGIO,I1,ist)
           call STDWRD(TabID,RDESCN(8),REGMAX,1,NREGIO,I1,ist)
           call STDWRD(TabID,RDESCN(9),WINSTE,1,NREGIO,I1,ist)
        end if
        call STDWRD(TabID,RDESCN(10),GR_LAB,1,1,I1,ist)
        call STDWRD(TabID,RDESCN(11),GR_TIC,1,1,I1,ist)
        call STDWRD(TabID,RDESCN(12),REDSH,1,1,I1,ist)
        call STDWRD(TabID,RDESCN(13),VELRAN,1,1,I1,ist)
        CALL TBTCLO(TabID,ist)

        i1=0                    !reset standard values
        i2=2
        i3=1
        call STECNT('PUT',i1,i2,i3)


        return
        end



C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        SUBROUTINE RSETUP(TblNam,IER)
C
C     
C       READS the system parameters from the descriptors 
C       of the table TblNam
C       On error in opening the table or reading filenames,  ier=1
C       On less severe errors, ier=2, and param. are set to defaults
C       otherwise ier=0
C
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        implicit none

        character*(*) TblNam
        integer ier

        include 'MID_REL_INCL:fit_var.inc'

        integer i1,i2,i3,itmp,i
        integer TabID,ist

        CHARACTER*20 CDESCN(50)
        CHARACTER*20 IDESCN(50)
        CHARACTER*20 RDESCN(50)
        CHARACTER*20 appogg
        character*60 app2

        integer NIDESC,NCDESC,nrdesc

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'

        ier=0
        CDESCN(1)='SPECTRUMTABLE'
        CDESCN(2)='OUTTAB'
        CDESCN(3)='LOGNAME'
        CDESCN(4)='GRALAB'
        CDESCN(5)='ZPLOT'
        NCDESC=5

        IDESCN(1)='TURBOLENCE'
        IDESCN(2)='GRAPHWIN'
        IDESCN(3)='I_MINOS'
        IDESCN(4)='GCOLOR'
        IDESCN(5)='I_RESIDUALS'
        IDESCN(6)='I_STDEV'
        IDESCN(7)='GREGION'
        NIDESC=7

        RDESCN(1)='LAMBDA_LIM'
        RDESCN(2)='COLDEN_LIM'
        RDESCN(3)='BTEMP_LIM'
        RDESCN(4)='BTURB_LIM'
        RDESCN(5)='GRAPH_BOTTOM'
        RDESCN(6)='GRAPH_TOP'
        RDESCN(7)='GRAPH_MIN'
        RDESCN(8)='GRAPH_MAX'
        RDESCN(9)='GRAPH_STEP'
        RDESCN(10)='GRAPH_LABEL'
        RDESCN(11)='GRAPH_TICK'
        RDESCN(12)='REDSHIFT'
        RDESCN(13)='VELRANGE'
        NRDESC=13

                    !doesn't stop at errors..
        call seterr('OFF')

        TURBLN=0
        I_GRAP=.false.
        I_Z=.false.
        I_RESD=.TRUE.
        I_VAR=.TRUE.
        IMINOS=0
        GCOLOR(1)=1             ! spectrum
        GCOLOR(2)=4             ! continuum
        GCOLOR(3)=2             ! fitted profile
        GCOLOR(4)=3             ! residuals
        GCOLOR(5)=6             ! stdev
        GCOLOR(6)=1             ! label
        GCOLOR(7)=2             ! line ticks
        LAMLIM(1)=0.
        LAMLIM(2)=0.
        LAMLIM(3)=0.005
        NLIM(1)=0.
        NLIM(2)=0.
        NLIM(3)=0.01
        BLIM(1)=0.
        BLIM(2)=0.
        BLIM(3)=0.01
        BTULIM(1)=.0
        BTULIM(2)=0.
        BTULIM(3)=0.01
        GR_BOT=0.5
        GR_TOP=0.5
        GR_LAB=0.2
        GR_TIC=1.2
        REDSH=0.D0
        VELRAN=0.D0
        do itmp = 1, NMXLIN
           LLABEL(itmp)=' '
        end do
        if (TblNam.eq.'SCRATCH') return

        call TBTOPN(TblNam,F_IO_MODE,TabID,ist)   !open
        if (ist .ne. 0 ) then       ! if it doesn't exist..           
           ier=1
           return
        end if

        ier=1
        call STDRDC(TabID,CDESCN(1),1,1,60,I2,FILSPE,I1,I3,ist)
        if (ist.ne.0) return
        call STDRDC(TabID,CDESCN(2),1,1,60,I2,FILOUT,I1,I3,ist)
        if (ist.ne.0) return
        call STDRDC(TabID,CDESCN(3),1,1,60,I2,FILLOG,I1,I3,ist)
        if (ist.ne.0) return

        i = index(FILSPE,' ') ! empty input filename
        if (i .eq. 1) return   

        i = index(FILOUT,' ') ! no out and log, using defaults
        if (i .eq. 1) then
           i=index(FILSPE,' ')
           FILOUT=FILSPE(1:i-1)//'FIT'
        end if   
        i = index(FILLOG,' ')
        if (i .eq. 1) then
           FILLOG=FILSPE
        endif

        ier=2
        call STDRDC(TabID,CDESCN(5),1,1,60,I2,app2,I1,I3,ist)
        if (ist.ne.0) I_Z=.false. !Backward compatibility
        if (app2.eq.'TRUE') I_Z = .true.
        if (app2.eq.'FALSE') I_Z = .false.

        call STDRDI(TabID,IDESCN(1),1,1,I2,TURBLN,I3,I1,ist)
        if (ist.ne.0) return

        call STDRDI(TabID,IDESCN(2),1,1,I2,ITMP,I3,I1,ist)
        if (ist.ne.0) return
        if (ITMP.eq.1) I_GRAP=.true.
        if (ITMP.eq.0) I_GRAP=.false.

        call STDRDI(TabID,IDESCN(3),1,1,I2,IMINOS,I3,I1,ist)
        if (ist.ne.0) return
        call STDRDI(TabID,IDESCN(4),1,7,I2,GCOLOR,I3,I1,ist)
        if (ist.ne.0) return
        call STDRDI(TabID,IDESCN(5),1,1,I2,ITMP,I3,I1,ist)
        if (ist.ne.0) return
        if (ITMP.eq.1) I_RESD=.true.
        if (ITMP.eq.0) I_RESD=.false.
        call STDRDI(TabID,IDESCN(6),1,1,I2,ITMP,I3,I1,ist)
        if (ist.ne.0) return
        if (ITMP.eq.1) I_VAR=.true.
        if (ITMP.eq.0) I_VAR=.false.

        call STDRDD(TabID,RDESCN(1),1,3,I2,LAMLIM ,I3,I1,ist)
        if (ist.ne.0) return
        call STDRDD(TabID,RDESCN(2),1,3,I2,NLIM ,I3,I1,ist)
        if (ist.ne.0) return
        call STDRDD(TabID,RDESCN(3),1,3,I2,BLIM ,I3,I1,ist)
        if (ist.ne.0) return
        call STDRDD(TabID,RDESCN(4),1,3,I2,BTULIM ,I3,I1,ist)
        if (ist.ne.0) return
        call STDRDD(TabID,RDESCN(5),1,1,I2, GR_BOT,I3,I1,ist)
        if (ist.ne.0) return
        call STDRDD(TabID,RDESCN(6),1,1,I2,GR_TOP ,I3,I1,ist)
        if (ist.ne.0) return
        call STDRDI(TabID,IDESCN(7),1,1,I2,NREGIO,I3,I1,ist)
        if (ist.ne.0) then  ! backward compatibility
         call STDRDD(TabID,RDESCN(9),1,NMXLIN,NREGIO,WINSTE ,I3,I1,ist)
         I_Z=.false.
        endif
        if (NREGIO .gt. 0) then
           call STDRDD(TabID,RDESCN(7),1,NREGIO,itmp,REGMIN ,I3,I1,ist)
           if (ist.ne.0) return
           call STDRDD(TabID,RDESCN(8),1,NREGIO,itmp,REGMAX ,I3,I1,ist)
           if (ist.ne.0) return
           call  STDRDD(TabID,RDESCN(9),1,NREGIO,itmp,WINSTE,I3,I1,ist)
        endif
        call STDRDD(TabID,RDESCN(10),1,1,I2,GR_LAB,I3,I1,ist)
c       if (ist.ne.0) return   ! to maintain compatibility with 94NOV
        call STDRDD(TabID,RDESCN(11),1,1,I2,GR_TIC,I3,I1,ist)
c       if (ist.ne.0) return   ! to maintain compatibility with 94NOV
        if (ist.ne.0) GR_TIC = 1.2  ! to maintain compatibility with 94NOV
        call STDRDD(TabID,RDESCN(12),1,1,I2,REDSH,I3,I1,ist)
        call STDRDD(TabID,RDESCN(13),1,1,I2,VELRAN,I3,I1,ist)

        if (NREGIO.gt.0) then   !legge labels
           do i=1,NREGIO
              write(appogg,'(a6,i2.2)')CDESCN(4),i
              call STDRDC(TabID,appogg,1,1,60,I2,LLABEL(i),I1,I3,ist)
              if (ist.ne.0) LLABEL(i)=' '
           end do
        end if

        CALL TBTCLO(TabID,ist)
        ier=0

        i1=0                    !reset standard values
        i2=2
        i3=1
        call STECNT('PUT',i1,i2,i3)


        return
        end