C @(#)rea.for	17.1.1.1 (ESO-IPG) 01/25/02 17:16:24

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  ReaSpe(NomSpe,n)
C     
C        Legge file contenente lo spettro da analizzare.
C     
C     NomSpe       (input):         Nome del file da aprire
C     n            (in/out):        In input: dimensione di alam e smod
C     in output: n. di punti letti.
C     Se < 0 errore di lettura.
C     
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
      
      implicit none
      character*(*) NomSpe
      integer n
      
      include 'MID_REL_INCL:fit_var.inc'
      integer iread,istat,is,k
      integer TABID,ColTab(10)
      DOUBLE PRECISION val(5)
      character*70 Mes
      integer irr,nj,i1,i2,i3,i4
      logical ilog(5),ipix

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     Open table
      call TBTOPN(NomSpe,F_IO_MODE,TABID,Istat)
      if (istat.ne.0) then 
         n=-istat
         write(Mes,*)n
         call sttdis(Mes,0,is)
         return
      end if
      call TBIGET(TABID,i1,nj,i2,i3,i4,irr)

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

      call TBLSER(TABID,'WAVE',ColTab(1),istat)
      if (istat .ne. 0) then
         call ErrMsg('Column WAVE not found - Aborting')
         n=-1
         return
      endif

      call TBLSER(TABID,'NORMFLUX',ColTab(2),istat)        
      if (istat .ne. 0) then
         call ErrMsg('Column NORMFLUX not found - Aborting')
         n=-2
         return
      endif

      call TBLSER(TABID,'STDEV',ColTab(3),istat)
      if (istat .ne. 0) then
         call ErrMsg('Column STDEV not found - Aborting')
         n=-3
         return
      endif

      call TBLSER(TABID,'FWHM',ColTab(4),istat)
      if (istat .ne. 0) then
         call ErrMsg('Column FWHM not found - Aborting')
         n=-4
         return
      endif

      call TBLSER(TABID,'PIXSIZE',ColTab(5),istat)
      ipix=.true.
      if (ColTab(5) .lt. 0) then
         ipix=.false.
         call WrnMsg('Column PIXSIZE not found - I will compute them')
      endif

                                ! READ DATA
      iread=0
      do irr = 1 , nj
         if (ipix) call TBRRDD(TABID,irr,5,ColTab,val,ilog,istat)
         if (.not.ipix) call TBRRDD(TABID,irr,4,ColTab,val,ilog,istat)
         if(ilog(1).or.ilog(2).or.ilog(3).or.ilog(4)) then
            continue
         else
            iread=iread+1
            XLAMBD(iread) = val(1)
            SPECTR(iread) = val(2)
            SIGNOI(iread) = val(3)
            FWHM(iread) = val(4)
            if (ipix) PIXSIZ(iread) = val(5)
         end if
         if (iread.eq.n) goto 101
      end do


 101  continue
      if (iread.eq.n) then
         Mes='****************** WARNING **********************'
         call DisMsg(Mes)
         Mes='*  Too many data for this program configuration'
         call DisMsg(Mes)
         Mes=' '
         call DisMsg(Mes)
         write(Mes,*)'*  Acquisition stopped after',iread,
     1        ' points.'
         call DisMsg(Mes)
         Mes=' '
         call DisMsg(Mes)
         Mes='*  Re-compile program to enlarge storage'
         call DisMsg(Mes)
         Mes='*************************************************'
         call DisMsg(Mes)         
      end if

      n=iread
      call TBTCLO(TABID,istat)

      do k = 1,n
         CONTIN(k) = 1.
         SKYLEV(k) = 0.
      end do      

      if (.not.ipix) then
         PIXSIZ(1) = XLAMBD(2) - XLAMBD(1)
         PIXSIZ(n) = XLAMBD(n) - XLAMBD(n-1)
         do irr = 2,n-1
            PIXSIZ(irr)= (XLAMBD(irr+1) - XLAMBD(irr-1))/2.
         enddo
      endif
      
      i1=0                      !stops on errors
      i2=2
      i3=1
      call STECNT('PUT',i1,i2,i3)

      return
      end