PROGRAM IUEDISK C C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C.IDENTIFICATION IUEDISK.FOR C.AUTHOR: J.D.PONZ ESA-VILSPA C.KEYWORDS IUE, GO FORMAT, RAW IMAGE C.PURPOSE C \begin{TeX} C Main program to convert IUE disk files in GO format into MIDAS. 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 Input filename C \item naming convention C \item flags for file format and header listing C \end{itemize} C \item Read the first header record to find the file type C \item Generate the filename according to the naming conventions C \end{enumerate} C \end{TeX} C C.LANGUAGE: F77 C.COMMENTS C \begin{TeX} C The program is started by the procedure {\tt IUEDISK.PRG} 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 24 JUN 1994 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 IOFF INTEGER STATUS, KUN(1), KNUL, ACTVAL, I INTEGER CHANL, INDEX, DSPFLG INTEGER LFID INTEGER CAMERA INTEGER IMANUM INTEGER APERTU INTEGER DISPER INTEGER NRECO, NBYTE INTEGER FTYPE INTEGER DSKFMT INTEGER NORD, ORDER(100) INTEGER MADRID(1) C CHARACTER*400 BUFF CHARACTER*80 INPUT, OUTPUT, FILE CHARACTER*5 FLAGS, NEWPAG CHARACTER*80 LINE COMMON/VMR/MADRID DATA NEWPAG/' '/ C C ... MIDAS environment C CALL STSPRO('IUEDISK') C C ... init variables for data conversion C CALL ISTCVI C C ... get input filename C INPUT=' ' CALL STKRDC('P1',1,1,80,ACTVAL,INPUT,KUN,KNUL,STATUS) CALL ISDOPN(INPUT,CHANL,STATUS) IF (STATUS.NE.0) THEN CALL STTPUT('*** Error in input file ***',STATUS) GOTO 9999 ENDIF C C ... get output filename C OUTPUT=' ' CALL STKRDC('P2',1,1,80,ACTVAL,OUTPUT,KUN,KNUL,STATUS) LFID = INDEX(OUTPUT,' ') - 1 C C ... get flags (Integer/Real/X raw+phot,Full/Short label listing) C FLAGS = ' ' CALL STKRDC('P3',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 ... process main header C IOFF = 0 CALL ISDHED(CHANL,BUFF,CAMERA,IMANUM,APERTU,DISPER, . FTYPE,NRECO,NBYTE,IOFF,STATUS) IF (STATUS.NE.0) THEN CALL ISTFHD(CHANL,BUFF,2,IOFF,STATUS) CALL STTPUT('*** Error in file header ***',STATUS) GOTO 200 ENDIF C C ... generate filename C IF (LFID.EQ.3 .AND. OUTPUT(1:3).EQ.'IUE') THEN CALL ISTFN1(CAMERA,IMANUM,APERTU,FTYPE,FILE) ELSE FILE = OUTPUT ENDIF C C ... process the file if requested C IF (FTYPE.EQ.FESTYP) THEN CALL ISDFES(CHANL,BUFF,FILE,DSKFMT,DSPFLG, . NRECO,NBYTE,IOFF,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(FTYPE.EQ.RAWTYP) THEN CALL ISDRAW(CHANL,BUFF,FILE,DSKFMT,DSPFLG,IOFF,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(FTYPE.EQ.PHOTYP) THEN CALL ISDPHO(CHANL,BUFF,FILE,DSKFMT,DSPFLG,IOFF,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(FTYPE.EQ.LBLTYP) THEN CALL ISDLBL(CHANL,BUFF,FILE,DSKFMT,NRECO,NBYTE, . DSPFLG,IOFF,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(FTYPE.EQ.LOWTYP) THEN CALL ISDLOW(CHANL,BUFF,FILE,DSKFMT,NRECO,NBYTE, . DSPFLG,IOFF,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(FTYPE.EQ.HIGTYP) THEN CALL ISDHIG(CHANL,BUFF,FILE,DSKFMT,NORD,ORDER,NRECO,NBYTE, . DSPFLG,IOFF,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 200 CONTINUE C C ... end C 9999 CALL STSEPI 10000 FORMAT(I3.3) C10001 FORMAT(I) 10001 FORMAT(I1) 10002 FORMAT(I2) 10003 FORMAT(I3) 10004 FORMAT(I4) END