C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.IDENTIFICATION        ISDFES.FOR
C.LANGUAGE:             F77 
C.AUTHOR:               J.D.PONZ  ESA-VILSPA        
C.KEYWORDS              IUE, GO FORMAT, FES IMAGE
C.PURPOSE
C  \begin{TeX}
C  Reads FES data.
C  The routine performs the following functions (routine names in brackets):
C  \begin{enumerate}
C  \item Handles the file header (ISDFHD)
C  \item Creates the MIDAS image file on disk (STFCRE). 
C     The format and size of the file is controlled by the 
C     argument DSKFMT (0 - floating point, 1 - byte).
C  \item  Iteration on the number of lines to:
C        \begin{itemize}
C         \item Read  a line (ISDREC)
C         \item Decode the pixel information
C         \item Write the line into disk (STFPUT).
C       \end{itemize}
C  \item Writes standard image descriptors (STDWRx)
C  \item Writes IUE specific descriptors (ISTDES).
C  \item Closes the file on disk (STFCLO)
C  \end{enumerate}
C \end{TeX}
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 \end{TeX}
C.VERSION: 1.0  INITIAL CODING  24 JUN 1994
C------------------------------------------------------------------
      SUBROUTINE ISDFES(CHANL,BUFF,FILE,DSKFMT,DSPFLG,
     .                  NRECO,NBYTE,IOFF,STATUS)
C
      IMPLICIT NONE
      INTEGER       CHANL             ! IN: tape channel number
      CHARACTER*(*) BUFF              ! IN: buffer with the ascii header
      CHARACTER*(*) FILE              ! IN: disk file name
      INTEGER       DSKFMT            ! IN: image format (0:float, 1:Byte)
      INTEGER       DSPFLG            ! IN: display flag
      INTEGER       NRECO             ! IN: number of records
      INTEGER       NBYTE             ! IN: number of bytes
      INTEGER       IOFF
      INTEGER       STATUS            ! OUT: status (0 normal return)
C
      INTEGER   DTYPE, NO, SIZE, FELM, NL, NR, LEN, I, J
      INTEGER   NAXIS(1), NPIX(2), DUM(1)
      INTEGER   IBUFF(768)
      REAL      RBUFF(768)
      REAL      CUTS(4)
      DOUBLE PRECISION START(2), STEP(2)
      CHARACTER*72 IDENT, CUNIT
      INCLUDE 'MID_INCLUDE:ST_DEF.INC'
      INCLUDE 'MID_INCLUDE:ST_DAT.INC'
      DATA CUNIT/'FESCNT          PIXEL           PIXEL    '/
C
C     NL     = 113
C     NR     = 113
C     SIZE   = 113*113
      NL     = NBYTE
      NR     = NRECO
      SIZE   = NRECO*NBYTE
      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 header
C
C ... create the frame
C
      IF (DSKFMT.EQ.0) THEN
          DTYPE = D_R4_FORMAT
      ELSE
          DTYPE = D_I1_FORMAT
      ENDIF
      CALL STFCRE(FILE,DTYPE,F_O_MODE,F_IMA_TYPE,SIZE,NO,STATUS)
      IF (STATUS.NE.0) RETURN
C
C ... loop to read tape and write into disk
C
      FELM = 1
      IF (DSKFMT.EQ.0) THEN                        ! write with conversion
        DO 10 I = 1, NL
           CALL ISDRBY(CHANL,IBUFF,NR,LEN,IOFF,STATUS)
           IF ((NR+IOFF).NE.LEN .OR. STATUS.NE.0) RETURN
           DO 5 J = 1, NR
              RBUFF(J) = IBUFF(J)
  5        CONTINUE
           CALL STFPUT(NO,FELM,NR,RBUFF,STATUS)
           IF (STATUS.NE.0) RETURN            
           FELM = FELM + NR
 10     CONTINUE
      ELSE                                         ! write without conversion
        DO 20 I = 1, NL
           CALL ISDRB1(CHANL,IBUFF,NR,LEN,IOFF,STATUS)
           IF ((NR+IOFF).NE.LEN .OR. STATUS.NE.0) RETURN
           CALL STFPUT(NO,FELM,NR,IBUFF,STATUS)
           IF (STATUS.NE.0) RETURN            
           FELM = FELM + NR
 20     CONTINUE
      ENDIF
C
C ... write image descriptors
C
      NAXIS(1) = 2
      NPIX(1)  = NBYTE
      NPIX(2)  = NRECO
      START(1) = 1.0D0
      START(2) = 1.0D0
      STEP(1)  = 1.0D0
      STEP(2)  = 1.0D0
      CUTS(1)  = 0.
      CUTS(2)  = 255.
      CUTS(3)  = 0.
      CUTS(4)  = 255.
      IDENT    = BUFF(145:210)
      CALL STDWRI(NO,'NAXIS',NAXIS,1,1,DUM,STATUS)
      CALL STDWRI(NO,'NPIX',NPIX,1,2,DUM,STATUS)
      CALL STDWRD(NO,'START',START,1,2,DUM,STATUS)
      CALL STDWRD(NO,'STEP',STEP,1,2,DUM,STATUS)
      CALL STDWRR(NO,'LHCUTS',CUTS,1,4,DUM,STATUS)
      CALL STDWRC(NO,'IDENT',1,IDENT,1,72,DUM,STATUS)
      CALL STDWRC(NO,'CUNIT',1,CUNIT,1,48,DUM,STATUS)
C
C ... write label descriptors
C
      CALL ISTDES(NO,BUFF,STATUS)
      CALL STFCLO(NO,STATUS)
      RETURN
      END