C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.IDENTIFICATION        ISTPHO.FOR
C.AUTHOR:               J.D.PONZ  ESA-VILSPA        
C.KEYWORDS              IUE, GO FORMAT, PHOTOM IMAGE
C.PURPOSE
C  \begin{TeX}
C    Reads the PHOTOM 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       \begin{itemize}
C         \item  0 = floating point
C         \item  1 = 2-byte two's complement integer
C         \item -1 = the disk file is not created. Used to list header only.
C       \end{itemize}
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 VMW EXTENSIONS. 14 APR 1992  
C------------------------------------------------------------------
      SUBROUTINE ISTPHO(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:I*2)
      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), NP
      INTEGER   IBUFF(768)
      INTEGER   BBUFF(1536)
      REAL      RBUFF(768)
      REAL      CUTS(4), XMAX
      DOUBLE PRECISION START(2), STEP(2)
      CHARACTER*72 IDENT, CUNIT
      INCLUDE 'MID_INCLUDE:ST_DEF.INC'
      EQUIVALENCE  (IBUFF(1),BBUFF(1))
      INCLUDE 'MID_INCLUDE:ST_DAT.INC'
      DATA CUNIT/'FN              PIXEL           PIXEL '/
C
      NL     = 768
      NR     = 1536
      NP     = 768
      STATUS = 0
      SIZE   = 768*768
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 displays the header
C
C ... create the frame
C
      IF (DSKFMT.EQ.0) THEN
          DTYPE = D_R4_FORMAT
      ELSE
          DTYPE = D_I2_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
      XMAX = 0.
      FELM = 1
      IF (DSKFMT.EQ.0) THEN                        ! write with conversion
        DO 10 I = 1, NL
           CALL ISTRHW(CHANL,BBUFF,NR,LEN,STATUS)
           IF (NR.NE.LEN .OR. STATUS.NE.0) RETURN
           DO 5 J = 1, NP
               RBUFF(J)  = IBUFF(J)
               XMAX      = AMAX1(XMAX,RBUFF(J))
  5        CONTINUE
           CALL STFPUT(NO,FELM,NP,RBUFF,STATUS)
           IF (STATUS.NE.0) RETURN            
           FELM = FELM + NP
 10     CONTINUE
      ELSE                                         ! write without conversion
        DO 20 I = 1, NL
           CALL ISTRH1(CHANL,BBUFF,NR,LEN,STATUS)
           IF (NR.NE.LEN .OR. STATUS.NE.0) RETURN
           CALL STFPUT(NO,FELM,NP,IBUFF,STATUS)
           IF (STATUS.NE.0) RETURN            
           FELM = FELM + NP
 20     CONTINUE
        XMAX = 32767                                ! MAXIMUM HARDCODED
      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)  = XMAX
      CUTS(3)  = 0.
      CUTS(4)  = XMAX
      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