C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C.IDENTIFICATION ISDRAW.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 (ISDFHD) C \item Creates the MIDAS image file (STFCRE) C \item Iterates on the image lines to: C \begin{itemize} C \item Read image line 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 24 JUN 1994 C------------------------------------------------------------------ SUBROUTINE ISDRAW(CHANL,BUFF,FILE,DSKFMT,DSPFLG,IOFF,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 IOFF 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 ISDFHD(CHANL,BUFF,DSPFLG,IOFF,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 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) = 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