PROGRAM IUEIN
C
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.IDENTIFICATION        IUEIN.FOR
C.AUTHOR:               J.D.PONZ  ESA-VILSPA        
C.KEYWORDS              IUE, GO FORMAT, RAW IMAGE
C.PURPOSE
C  \begin{TeX}
C   Main program to read IUE tapes in GO format.
C   Files are created with the following formats
C   \begin{description}
C      \item[{\tt RAW}]   2-Dimensional image in byte or floating point format.
C      \item[{\tt PHOT}]  2-Dimensional image in byte or floating point format.
C      \item[{\tt LBL}]   2-Dimensional image in byte or floating point format.
C      \item[{\tt MELO}]  table file.
C      \item[{\tt MEHI}]  table file.
C   \end{description}
C
C   The files {\tt MELO} and {\tt MEHI} are tables with the following columns:
C   \begin{description}
C      \item[{\tt WAVELENGTH}]  {\tt R*4}  wavelenghts
C      \item[{\tt EPSILON}]     {\tt I*4}    quality flags
C      \item[{\tt GROSS}]       {\tt R*4}    gross spectrum
C      \item[{\tt BACK}]        {\tt R*4}    background estimation
C      \item[{\tt NET}]         {\tt R*4}    net spectrum
C      \item[{\tt RNET}]        {\tt R*4}    ripple corrected net (only high disp)
C      \item[{\tt FLUX}]        {\tt R*4}    absolute flux
C      \item[{\tt ORDER}]       {\tt I*4}    spectral order number (only high disp)
C  \end{description}
C \end{TeX}
C.ALGORITHM
C \begin{TeX}
C   \begin{enumerate}
C   \item Read parameters defining:
C       \begin{itemize}
C       \item file specifications
C       \item  naming convention
C       \item tape device 
C       \item selection by file type
C       \item flags for file format and header listing
C       \end{itemize}
C   \item Position the device for tape input
C   \item Read the first header record to find the file type
C   \item Generate the filename according to the naming conventions
C   \item Process the file if the file type agrees with the requested one(s)
C   \item Skip the EOF for tape input
C   \end{enumerate}
C \end{TeX}
C
C.LANGUAGE:               F77 
C.COMMENTS
C \begin{TeX}
C   The program is started by the procedure {\tt IUEIN.PRG}, 
C   command {\tt IUEIN}.
C
C   The following extensions are used:
C \begin{itemize}
C    \item  IMPLICIT NONE
C    \item  long variable names
C \end{itemize}
C \end{TeX}
C.VERSION: 1.0  INITIAL CODING  09 JUL 1990
C.VERSION: 1.1  24 Sep 1991. Include several FES sizes and modify error
C                            handling. On read/decode error displays the
C                            full header if possible and skips the file.
C.VERSION: 1.2  14 Apr 1992. Remove VMS extensions.
C--------------------------------------------------------------------
C
C  data declaration
C
       IMPLICIT NONE
C                                   define data types as parameters
       INTEGER  FESTYP, RAWTYP, PHOTYP, LBLTYP, LOWTYP, HIGTYP
       PARAMETER (FESTYP=0)
       PARAMETER (RAWTYP=1)
       PARAMETER (PHOTYP=2)
       PARAMETER (LBLTYP=3)
       PARAMETER (LOWTYP=4)
       PARAMETER (HIGTYP=5)
C
       INTEGER                STATUS, KUN(1), KNUL, ACTVAL, I
       INTEGER                CHANL, INDEX, DSPFLG
       INTEGER                LFID, SCANFLAG, SPECEND, L, N
       INTEGER                SPECOFF, FSTART, FHERE, INTINDX
       INTEGER                LENINT, ENDINDX
       INTEGER                LENF, LENL, SLEN, FEND, SKIP
       INTEGER                CAMERA
       INTEGER                IMANUM
       INTEGER                APERTU
       INTEGER                DISPER
       INTEGER                NRECO, NBYTE
       INTEGER                FTYPE
       INTEGER                DSKFMT
       INTEGER                NORD, ORDER(100)
       INTEGER                MADRID(1)
C
       LOGICAL                FES, RAW, PHO, LBL, LOW, HIG
C
       CHARACTER*10           INTVAL
       CHARACTER*4            FFILE, LFILE
       CHARACTER*400          BUFF            
       CHARACTER*80           INPUT, FID, FILE, IMATYP, FSPECS, FIDEL
       CHARACTER*72           TEXT0, TEXT1
       CHARACTER*5            FLAGS, NEWPAG
       CHARACTER*10           NOFIL
       CHARACTER*80           LINE
       COMMON/VMR/MADRID
       DATA                   TEXT0/' '/
       DATA                   TEXT1/'  File number : '/
       DATA                    NEWPAG/' '/
C
C ...  MIDAS environment
C
        CALL STSPRO('IUEIN')
C
C ... init variables for data conversion
C
        CALL ISTCVI
C
C ... get tape unit 
C
        INPUT=' '
        CALL STKRDC('P3',1,1,80,ACTVAL,INPUT,KUN,KNUL,STATUS)
        CALL ISTOPN(INPUT,CHANL,STATUS)
        IF (STATUS.NE.0) THEN
          CALL STTPUT('*** Error in tape allocation ***',STATUS)
          GOTO 9999
        ENDIF  
        CALL ISTREW(CHANL,STATUS)
        IF (STATUS.NE.0) THEN
          CALL STTPUT('*** Error rewinding tape ***',STATUS)
          GOTO 9999
        ENDIF  
C
C ... get file identification
C
        INPUT=' '
        CALL STKRDC('P2',1,1,80,ACTVAL,INPUT,KUN,KNUL,STATUS)
        LFID  = INDEX(INPUT,' ') - 1
        FID   = INPUT
        FIDEL = FID
        CALL ISTUPC(FID,FID)

C ... get IUE data type selection
C
       CALL STKRDC('P4',1,1,80,ACTVAL,IMATYP,KUN,KNUL,STATUS)
       CALL ISTUPC(IMATYP,IMATYP)
       IF (IMATYP(1:1).EQ.'A') THEN   ! Select all data types by default
           FES = .TRUE.
           RAW = .TRUE.
           PHO = .TRUE.
           LBL = .TRUE.
           LOW = .TRUE.
           HIG = .TRUE.
       ELSE                        ! Types explicitly selected
           FES = .FALSE.
           RAW = .FALSE.
           PHO = .FALSE.
           LBL = .FALSE.
           LOW = .FALSE.
           HIG = .FALSE.
           I = INDEX(IMATYP,'F')          ! FES DATA
           IF (I.GT.0) FES = .TRUE.
           I = INDEX(IMATYP,'R')          ! RAW DATA
           IF (I.GT.0) RAW = .TRUE.
           I = INDEX(IMATYP,'P')          ! PHOTOM DATA
           IF (I.GT.0) PHO = .TRUE.
           I = INDEX(IMATYP,'E')          ! (EXTENDED) LBL DATA
           IF (I.GT.0) LBL = .TRUE.
           I = INDEX(IMATYP,'L')          ! LOW DISPERSION SPEC. DATA
           IF (I.GT.0) LOW = .TRUE.
           I = INDEX(IMATYP,'H')          ! HIGH DISPERSION SPEC. DATA
           IF (I.GT.0) HIG = .TRUE.
       ENDIF
C
C ... get flags (Integer/Real/X raw+phot,Full/Short label listing)
C
        FLAGS = ' '
        CALL STKRDC('P5',1,1,5,ACTVAL,FLAGS,KUN,KNUL,STATUS)
        CALL ISTUPC(FLAGS,FLAGS)
        DSKFMT = 1                   ! default is integer data on disk
        I = INDEX(FLAGS,'R')
        IF (I.GT.0) DSKFMT = 0       ! real data on disk
        I = INDEX(FLAGS,'X')
        IF (I.GT.0) DSKFMT = -1      ! no disk file
C
        DSPFLG = 1                   ! default is Short listing
        I = INDEX(FLAGS,'N')
        IF (I.GT.0) DSPFLG = 0       ! No listing
        I = INDEX(FLAGS,'F')
        IF (I.GT.0) DSPFLG = 2       ! Full listing
C
C ... get file specs
C
       CALL STKRDC('P1',1,1,80,ACTVAL,INPUT,KUN,KNUL,STATUS)
       SCANFLAG  = 0
       SPECEND   = INDEX(INPUT,' ')
       INPUT(SPECEND:SPECEND+1) = ',,'
       IF (SPECEND.LE.0) SPECEND = ACTVAL
C
C ... remove blanks
       L = 1
       DO 10 N = 1, SPECEND
          IF(INPUT(N:N).NE.' ') THEN
             FSPECS(L:L) = INPUT(N:N)
             L = L + 1
          ENDIF
 10    CONTINUE
       SPECEND = L
C
C ... initialize offset in FSPECS and pointer to current index in magtape
C
       SPECOFF = 1
       FSTART  = 1
C
C ... loop here between different specs
 80    FHERE   = FSTART
       INTINDX = INDEX(FSPECS(SPECOFF:),',')
       LENINT  = INTINDX - 1
       IF (LENINT.LE.0) GO TO 9999
C
       INTVAL  = FSPECS(SPECOFF:SPECOFF+INTINDX-2)//' '
       SPECOFF = SPECOFF + INTINDX
       ENDINDX = INDEX(INTVAL,'-')
C
       IF (ENDINDX.LE.0) THEN
          FFILE = INTVAL
          LENF  = LENINT
          LFILE = INTVAL
          LENL  = LENINT
       ELSE
          FFILE = INTVAL(1:ENDINDX-1)
          LENF  = ENDINDX - 1
          LFILE = INTVAL(ENDINDX+1:)
          LENL  = LENINT - ENDINDX
       ENDIF
       SLEN = LENF
       IF      (SLEN.EQ.1) THEN
          READ(FFILE,10001) FSTART
       ELSE IF (SLEN.EQ.2) THEN
          READ(FFILE,10002) FSTART
       ELSE IF (SLEN.EQ.3) THEN
          READ(FFILE,10003) FSTART
       ELSE IF (SLEN.EQ.4) THEN
          READ(FFILE,10004) FSTART
       ELSE
          CALL STTPUT('*** Error in FILESPEC ***',STATUS)
          GOTO 9999
       ENDIF  
       SLEN = LENL
       IF      (SLEN.EQ.1) THEN
          READ(LFILE,10001) FEND
       ELSE IF (SLEN.EQ.2) THEN
          READ(LFILE,10002) FEND
       ELSE IF (SLEN.EQ.3) THEN
          READ(LFILE,10003) FEND
       ELSE IF (SLEN.EQ.4) THEN
          READ(LFILE,10004) FEND
       ELSE
          CALL STTPUT('*** Error in FILESPEC ***',STATUS)
          GOTO 9999
       ENDIF  
C
C ... move to start file.
C
       SKIP = FSTART - FHERE
       IF (SKIP .GT. 0) THEN
          CALL ISTSKP(CHANL,SKIP,STATUS)
          IF (STATUS.NE.0) THEN
             CALL STTPUT(' *** Error in file skip ***',STATUS)
             GOTO 9999
          ENDIF
       ELSE
          IF (SKIP.LT.0) GO TO 9999
       ENDIF
 100   CONTINUE
C
C ... display a few lines
C
       WRITE(NOFIL,10000) FSTART
       CALL STTPUT(NEWPAG,STATUS)
       TEXT1(18:22) = NOFIL
       CALL STTPUT(TEXT1,STATUS)
       CALL STTPUT(TEXT0,STATUS)
C
C ... process main header
C
       CALL ISTHED(CHANL,BUFF,CAMERA,IMANUM,APERTU,DISPER,
     .             FTYPE,NRECO,NBYTE,STATUS)
       IF (STATUS.NE.0) THEN
           CALL ISTFHD(CHANL,BUFF,2,STATUS)
           CALL STTPUT('*** Error in file header ***',STATUS)
           GOTO 200
       ENDIF 
C
C ... generate filename
C
       IF (LFID.EQ.3 .AND. FID(1:3).EQ.'IUE') THEN
          CALL ISTFN1(CAMERA,IMANUM,APERTU,FTYPE,FILE)
       ELSE
          CALL ISTFN2(FIDEL,FSTART,FILE)
       ENDIF
C
C ... process the file if requested
C
       IF (FES .AND. FTYPE.EQ.FESTYP) THEN
         CALL ISTFES(CHANL,BUFF,FILE,DSKFMT,DSPFLG,
     .               NRECO,NBYTE,STATUS)                        ! PROCESS FES
         IF (STATUS.NE.0) THEN
           CALL STTPUT('*** Error reading FES file ***',STATUS)
           GOTO 200
         ELSE
           LINE = 'FES image written into file: '// FILE
           IF (DSKFMT.NE.-1) CALL STTPUT(LINE,STATUS)
         ENDIF
       ELSEIF(RAW .AND. FTYPE.EQ.RAWTYP) THEN
         CALL ISTRAW(CHANL,BUFF,FILE,DSKFMT,DSPFLG,STATUS)       ! PROCESS RAW
         IF (STATUS.NE.0) THEN
           CALL STTPUT('*** Error reading RAW file ***',STATUS)
           GOTO 200
         ELSE
           LINE = 'RAW image written into file: '// FILE
           IF (DSKFMT.NE.-1) CALL STTPUT(LINE,STATUS)
         ENDIF
       ELSEIF(PHO .AND. FTYPE.EQ.PHOTYP) THEN
         CALL ISTPHO(CHANL,BUFF,FILE,DSKFMT,DSPFLG,STATUS)    ! PROCESS PHOTOM
         IF (STATUS.NE.0) THEN
           CALL STTPUT('*** Error reading PHOT file ***',STATUS)
           GOTO 200
         ELSE
           LINE = 'PHOT image written into file: '// FILE
           IF (DSKFMT.NE.-1) CALL STTPUT(LINE,STATUS)
         ENDIF
       ELSEIF(LBL .AND. FTYPE.EQ.LBLTYP) THEN
         CALL ISTLBL(CHANL,BUFF,FILE,DSKFMT,NRECO,NBYTE,
     .                DSPFLG,STATUS)       ! PROCESS LBL
         IF (STATUS.NE.0) THEN
           CALL STTPUT('*** Error reading (E)LBL file ***',STATUS)
           GOTO 200
         ELSE
           LINE = '(E)LBL image written into file: '// FILE
           IF (DSKFMT.NE.-1) CALL STTPUT(LINE,STATUS)
         ENDIF
       ELSEIF(LOW .AND. FTYPE.EQ.LOWTYP) THEN
         CALL ISTLOW(CHANL,BUFF,FILE,DSKFMT,NRECO,NBYTE,
     .               DSPFLG,STATUS)              ! PROCESS LOW DISP
         IF (STATUS.NE.0) THEN
           CALL STTPUT('*** Error reading MELO file ***',STATUS)
           GOTO 200
         ELSE
           LINE = 'MELO spectra written into file: '// FILE
           IF (DSKFMT.NE.-1) CALL STTPUT(LINE,STATUS)
         ENDIF
       ELSEIF(HIG .AND. FTYPE.EQ.HIGTYP) THEN
         CALL ISTHIG(CHANL,BUFF,FILE,DSKFMT,NORD,ORDER,NRECO,NBYTE,
     .               DSPFLG,STATUS)  ! PROCESS HIGH DISP 
         IF (STATUS.NE.0) THEN
           CALL STTPUT('*** Error reading MEHI file ***',STATUS)
           GOTO 200
         ELSE
           LINE = 'MEHI spectra written into file: '// FILE
           IF (DSKFMT.NE.-1) CALL STTPUT(LINE,STATUS)
         ENDIF
       ENDIF
C
C ... skip the EOF
C
200    CONTINUE
       CALL ISTSKP(CHANL,1,STATUS)   
       IF (STATUS.NE.0) THEN
           CALL STTPUT('*** Error in file skip ***',STATUS)
           GOTO 9999
       ENDIF
C
C ... next file
C
       FSTART = FSTART + 1
       IF (FSTART.LE.FEND) THEN
           GOTO 100
       ELSE
           GOTO 80
       ENDIF
C
C ... end
C
 9999  CALL STSEPI
10000  FORMAT(I3.3)
C10001  FORMAT(I<SLEN>)
10001  FORMAT(I1)
10002  FORMAT(I2)
10003  FORMAT(I3)
10004  FORMAT(I4)
       END