C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.IDENTIFICATION        ISTRAW.FOR
C.AUTHOR:               J.D.PONZ  ESA-VILSPA        
C.KEYWORDS              IUE, GO FORMAT, RAW IMAGE
C.PURPOSE
C \begin{TeX}
C    Reads the raw image file and stores the information into a MIDAS 
C    image. The format of the image is controlled by the argument
C    DSKFMT as follows:
C           0 = floating point
C           1 = byte
C          -1 = the disk file is not created. Used to list header only.
C
C    The routine performs the following functions (routine name in brackets)
C    \begin{enumerate}
C    \item Handles the file header (ISTFHD)
C    \item Creates the MIDAS image file (STFCRE)
C    \item Iterates on the image lines to:
C          \begin{itemize}
C           \item Read image line (ISTREA)
C           \item Decode pixel info according to DSKFMT
C           \item Write line into file (STFPUT)
C          \end{itemize}
C    \item Writes standard image descriptors (STDWRx)
C    \item Writes IUE specific descriptors (ISTDES)
C    \item Closes the image file (STFCLO)
C    \end{enumerate}
C \end{TeX}
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 \end{TeX}
C.VERSION: 1.0  INITIAL CODING  09 JUL 1990
C.VERSION: 1.1  REMOVE VMS EXTENSIONS
C------------------------------------------------------------------
      SUBROUTINE ISTRAW(CHANL,BUFF,FILE,DSKFMT,DSPFLG,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 (0:R*4,  1:Byte)
      INTEGER       DSPFLG            ! IN: DISPLAY FLAG
      INTEGER       STATUS            ! OUT: status
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)
      CHARACTER*72 IDENT, CUNIT
      DOUBLE PRECISION START(2), STEP(2)
      INCLUDE 'MID_INCLUDE:ST_DEF.INC'
      INCLUDE 'MID_INCLUDE:ST_DAT.INC'
      DATA CUNIT/'DN              PIXEL           PIXEL     '/
C
      NL     = 768
      NR     = 768
      SIZE   = 768*768
      STATUS = 0
C
C ... decode full header, print it and put info in common area
C
      CALL ISTFHD(CHANL,BUFF,DSPFLG,STATUS)
      IF (STATUS.NE.0) RETURN
      IF (DSKFMT.LT.0) RETURN    ! only header list
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 ISTRBY(CHANL,IBUFF,NR,LEN,STATUS)
           IF (NR.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 ISTRB1(CHANL,IBUFF,NR,LEN,STATUS)
           IF (NR.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)  = 768
      NPIX(2)  = 768
      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
