C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.IDENTIFICATION        ISDLOW.FOR
C.AUTHOR:               J.D.PONZ  ESA-VILSPA        
C.KEYWORDS              IUE, GO FORMAT, LOW DISPERSION SPECTRUM
C.PURPOSE
C  \begin{TeX}
C  Reads low dispersion spectra and stores the 
C  information into a MIDAS table.
C
C  The routine performs the following functions:
C  \begin{enumerate}
C  \item Handles the file header (ISDFHD)
C  \item Creates the MIDAS table file (TBTINI)
C  \item Read wavelength record  and decodes the values
C  \item Creates a column to store the wavelengths (TBCINI)
C  \item Writes the wavelengths into the table column (TBEWRR)
C  \item  Read epsilon record and decodes the values
C  \item Creates a column to store the epsilon flags (TBCINI)
C  \item Writes the values into the table column (TBEWRI)
C  \item For each extracted spectrum (GROSS, BACKGROUND, NET, ABS. FLUX):
C        \begin{itemize}
C        \item Read  record (ISTREA) and decodes the values
C        \item  Creates a column to store the values (TBCINI)
C        \item Writes the values into the table column (TBEWRR)
C        \end{itemize}
C  \item Writes IUE specific descriptors (ISTDES)
C  \item Closes table file (TBTCLO)
C  \end{enumerate}
C \end{TeX}
C
C.LANGUAGE:             F77 
C.COMMENTS
C \begin{TeX}
C The following extensions are used:
C  \begin{itemize}
C     \item IMPLICIT NONE
C     \item INCLUDE statement
C     \item long variable names
C     \item Underscore character
C  \end{itemize}
C.VERSION: 1.0  INITIAL CODING  24 JUN 1994
C------------------------------------------------------------------
      SUBROUTINE ISDLOW(CHANL,BUFF,FILE,DSKFMT,
     .                  NRECO,NBYTE,DSPFLG,IOFF,STATUS)
C
      IMPLICIT NONE
      INTEGER       CHANL             ! IN: tape channel number
      CHARACTER*(*) BUFF              ! IN: buffer with the ascii header
      CHARACTER*(*) FILE              ! IN: file name
      INTEGER       DSKFMT            ! IN: disk format (-1 no file)
      INTEGER       NRECO             ! IN: number of records
      INTEGER       NBYTE             ! IN: number of bytes per record
      INTEGER       DSPFLG            ! IN: display flag
      INTEGER       STATUS            ! OUT: status
C
      INTEGER I, LEN, NROW, LAM0, TID, IROW, IVAL, IVALUE,IOFF
      INTEGER JG, KG, JB, KB, JN, KN, JF, KF, IC
      INTEGER    BBUFF(1024)
      INTEGER    IBUFF(1024)
      REAL    VALUE, SCG, SCB, SCN, SCF
      CHARACTER*16 LLABEL,ELABEL,GLABEL,BLABEL,NLABEL,FLABEL
      CHARACTER*16 LUNIT,EUNIT,GUNIT,BUNIT,NUNIT,FUNIT
      CHARACTER*8  LFORM,EFORM,GFORM,BFORM,NFORM,FFORM
C
      INCLUDE 'MID_INCLUDE:ST_DEF.INC'
      EQUIVALENCE (BBUFF,IBUFF)
      INCLUDE 'MID_INCLUDE:ST_DAT.INC'
C
      DATA LLABEL/'WAVELENGTH'/,ELABEL/'EPSILON'/
      DATA GLABEL/'GROSS'/,     BLABEL/'BACKGROUND'/
      DATA NLABEL/'NET'/,       FLABEL/'FLUX'/
      DATA LUNIT/'ANGSTROM'/, EUNIT/'UNITLESS'/
      DATA GUNIT/'FN'/,       BUNIT/'FN'/
      DATA NUNIT/'FN'/,       FUNIT/'ERG/CM2/A'/
      DATA LFORM/'F8.3'/, EFORM/'I5'/
      DATA GFORM/'E12.4'/
      DATA BFORM/'E12.4'/
      DATA NFORM/'E12.4'/
      DATA FFORM/'E12.4'/
C
      STATUS = 0
C
C ... decode full header, print it and put info in common area
C
      CALL ISDFHD(CHANL,BUFF,DSPFLG,IOFF,STATUS)
      IF (STATUS.NE.0) RETURN
      IF (DSKFMT.LT.0) RETURN     ! only displays the header
C
C ... reads record zero
C
      CALL ISDRHW(CHANL,BBUFF,NBYTE,LEN,IOFF,STATUS)
      IF ((NBYTE+IOFF).NE.LEN .OR. STATUS.NE.0) RETURN
C
C ... extracts useful info
C
      NROW = IBUFF(303)
      LAM0 = IBUFF(103)
      JG   = IBUFF(23)
      KG   = IBUFF(24)
      JB   = IBUFF(27)
      KB   = IBUFF(28)
      JN   = IBUFF(31)
      KN   = IBUFF(32)
      JF   = IBUFF(35)
      KF   = IBUFF(36)
      SCG  = JG/(2.**KG)
      SCB  = JB/(2.**KB)
      SCN  = JN/(2.**KN)
      SCF  = JF/(2.**KF)
C
C ... create the table file
C
      CALL TBTINI(FILE,F_TRANS,F_O_MODE,10,NROW,TID,STATUS)
      IF (STATUS.NE.0) RETURN
C
C ... scaled wavelengths
C
      CALL ISDRHW(CHANL,BBUFF,NBYTE,LEN,IOFF,STATUS)
      IF ((NBYTE+IOFF).NE.LEN .OR. STATUS.NE.0) RETURN
      CALL TBCINI(TID,D_R4_FORMAT,1,LFORM,LUNIT,LLABEL,IC,STATUS)
      IROW = 1
      IVAL = 3
      DO 10 I = 5, NBYTE, 2
          VALUE      = LAM0+0.2*IBUFF(IVAL)    
          CALL TBEWRR(TID,IROW,IC,VALUE,STATUS)
          IVAL = IVAL + 1
          IROW = IROW + 1
          IF (IROW.GT.NROW) GOTO 15
 10   CONTINUE
C
C ... epsilons
C
 15   CALL ISDRHW(CHANL,BBUFF,NBYTE,LEN,IOFF,STATUS)
      IF ((NBYTE+IOFF).NE.LEN .OR. STATUS.NE.0) RETURN
      CALL TBCINI(TID,D_I4_FORMAT,1,EFORM,EUNIT,ELABEL,IC,STATUS)
      IROW = 1
      IVAL = 3
      DO 20 I = 5, NBYTE, 2
          IVALUE     = IBUFF(IVAL)    
          CALL TBEWRI(TID,IROW,IC,IVALUE,STATUS)
          IVAL = IVAL + 1
          IROW = IROW + 1
          IF (IROW.GT.NROW) GOTO 25
 20   CONTINUE
C
C ... GROSS
C
 25   CALL ISDRHW(CHANL,BBUFF,NBYTE,LEN,IOFF,STATUS)
      IF ((NBYTE+IOFF).NE.LEN .OR. STATUS.NE.0) RETURN
      CALL TBCINI(TID,D_R4_FORMAT,1,GFORM,GUNIT,GLABEL,IC,STATUS)
      IROW = 1
      IVAL = 3
      DO 30 I = 5, NBYTE, 2
          VALUE      = IBUFF(IVAL)*SCG
          CALL TBEWRR(TID,IROW,IC,VALUE,STATUS)
          IVAL = IVAL + 1
          IROW = IROW + 1
          IF (IROW.GT.NROW) GOTO 35
 30   CONTINUE
C
C ... BACKGROUND
C
 35   CALL ISDRHW(CHANL,BBUFF,NBYTE,LEN,IOFF,STATUS)
      IF ((NBYTE+IOFF).NE.LEN .OR. STATUS.NE.0) RETURN
      CALL TBCINI(TID,D_R4_FORMAT,1,BFORM,BUNIT,BLABEL,IC,STATUS)
      IROW = 1
      IVAL = 3
      DO 40 I = 5, NBYTE, 2
          VALUE      = IBUFF(IVAL)*SCB
          CALL TBEWRR(TID,IROW,IC,VALUE,STATUS)
          IVAL = IVAL + 1
          IROW = IROW + 1
          IF (IROW.GT.NROW) GOTO 45
 40   CONTINUE
C
C ... NET
C
 45   CALL ISDRHW(CHANL,BBUFF,NBYTE,LEN,IOFF,STATUS)
      IF ((NBYTE+IOFF).NE.LEN .OR. STATUS.NE.0) RETURN
      CALL TBCINI(TID,D_R4_FORMAT,1,NFORM,NUNIT,NLABEL,IC,STATUS)
      IROW = 1
      IVAL = 3
      DO 50 I = 5, NBYTE, 2
          VALUE      = IBUFF(IVAL)*SCN    
          CALL TBEWRR(TID,IROW,IC,VALUE,STATUS)
          IVAL = IVAL + 1
          IROW = IROW + 1
          IF (IROW.GT.NROW) GOTO 55
 50   CONTINUE
C
C ... FLUX
C
 55   CALL ISDRHW(CHANL,BBUFF,NBYTE,LEN,IOFF,STATUS)
      IF ((NBYTE+IOFF).NE.LEN .OR. STATUS.NE.0) RETURN
      CALL TBCINI(TID,D_R4_FORMAT,1,FFORM,FUNIT,FLABEL,IC,STATUS)
      IROW = 1
      IVAL = 3
      DO 60 I = 5, NBYTE, 2
          VALUE      = IBUFF(IVAL)*SCF
          CALL TBEWRR(TID,IROW,IC,VALUE,STATUS)
          IVAL = IVAL + 1
          IROW = IROW + 1
          IF (IROW.GT.NROW) GOTO 65
 60   CONTINUE
C
C ... write label descriptors
C
 65   CONTINUE
      CALL ISTDES(TID,BUFF,STATUS)
      CALL TBTCLO(TID,STATUS)
      RETURN
      END
