PROGRAM RFITS C C.............PROGRAM TO READ FITS TAPE OF 2-D IMAGES (SPECTRA) C CREATED BY ED ANDERSON (NOAO), MAY 1985. C C PORTED TO VM/CMS 1/30/90 C JAMES C. NEWTON C UNIVERISTY OF MISSOURI-COLUMBIA C CCJIMN@UMCVMB.BITNET OR C CCJIMN@UMCVMB.MISSOURI.EDU C C C THIS PROGRAM WILL MAKE PIXEL FILES: C FITS BIN A,UNFORMATTED REAL*8 DATA C FITS PIX A,FORMATTED DATA (8(F9.1,1X)) C AND A SEPARATE HEADER FILE: FITS HDR A C C THIS EXAMPLE IS WRITTEN IN IBM VSFORTRAN REV 2.3 C C...................................................................... C...................................................................... C C INPUT FORMATS -- THE INPUT TO THIS PROGRAM IS EXPECTED TO BE EITHER C A TAPE FILE OR A TAPE FILE THAT HAS BEEN COPIED TO DISK. C WITHOUT HAVE BEEN CONVERTED FROM ACSII TO EBCDIC. THE C FILE MUST BE IN SIMPLE FITS FORMAT. C C**WARNING: THIS PROGRAM IS IN NO WAY A GENERAL FITS READER. IT SHOULD C BE USED AS A GUIDE TO WRITING A FITS READER TO THE C SPECIFICATIONS OF THE USER. THIS PROGRAM READS ONLY ONE C FITS FILE PER RUN AND THE TAPE MUST BE POSITIONED BY SOME C OTHER MEANS. C C OUTPUT FORMATS --THE PIXEL DATA IS WRITTEN TO DISK IN THE SAME ORDER C IN WHICH IT WAS PLACED ON INTO THE FITS FILE. THE FITS DATA C IS PROCESSED WITH THE FORMULA: C C OUTPUT = FTS_DATA * BSCALE + BZERO C DEFAULT VALUES: BSCALE = 1.0 C BZERO = 0.0 C C THE ASCII DATA IN THE HEADER IS CONVERTED TO EBCDIC DATA C AND WRITTEN OUT IN FILE FITS HDR. C C....................................................................... C C CHARACTER CARDS(36)*80, OBJECT*28 CHARACTER*6 KEY(9), KEYCRD CHARACTER*2880 STR LOGICAL ENDHEAD, LS INTEGER*2 BITPIX, NAXIS, LCOUNT, IBUF(1440) REAL*4 LINOUT(512), BSCALE, BZERO EQUIVALENCE (CARDS,ICARD),(IBUF,ICARD),(STR,CARDS) DATA KEY/'SIMPLE','BITPIX','NAXIS ','NAXIS1','NAXIS2', + 'OBJECT','BSCALE','BZERO ','END '/ DATA ENDHEAD,BIT16/.FALSE.,65536.0/ C C C.....................................................THE TAPE CHANNEL C C THE FITS DATA IS READ IN ON UNIT 5 WHICH NEEDS TO BE DEFINED C VIA A CMS FILEDEF STATEMENT. THE INPUT DATA IS EXPECTED TO BE IN C FOR DISK FILES: FILEDEF 5 DISK FN FT FM (RECFM=F LRECL=2880 PERM C FOR TAPE FILES: FILEDEF 5 TAP1 (BLKSIZE=2880 RECFM=F LRECL=2880 C IF USING TAPE FILES THE TAPE MUST BE POSITIONED TO THE START OF THE C FITS FILE. NOT THE HEADER (THE TAPE IS STANDARD LABELED) C C................................................OPEN OUTPUT HEADER FILE C C IT IS NOT NECESSARY TO SAVE THE C HEADER INFORMATION AT ALL, PROVIDED THAT YOU DO NOT WANT TO C WRITE OUT A NEW FITS TAPE. C C NOTE, THAT A MORE GENERAL FITS READER, WILL QUERY THE USER FOR C THE FILE NAMES. C C OPEN (UNIT=1, FILE='/FITS HDR A', STATUS='UNKNOWN') C C.............................................................READ HEADER C C THE NEXT TWO SECTIONS READ ONE TAPE BLOCK, CONVERT IT FROM C ASCII TO EBCDIC, AND DECIPHER THE HEADER CARDS. C C IF THE END KEYWORD HAS NOT BEEN FOUND IN THE FIRST TAPE BLOCK , then C THE PROGRAM WILL READ THE NEXT TAPE BLOCK ASSUMING THAT IT AL so C CONTAINS HEADER INFORMATION. C C YOU CAN SEARCH FOR ANY FITS KEYWORD YOU WISH, BUT THE NECESSARY ry ones C ARE THE NUMBER OF AXES NAXIS, AND THEIR SIZES (NAXIS1, NAXIS2) ...), C 2 READ(5,600)CARDS 600 FORMAT(36(A80)) C C.................................CONVERT THE HEADER RECORD TO EBCDIC CALL A2E(STR,2880) C C...........................DECODE HEADER CARDS AND PRINT TO FITS HDR A DO 14 I=1, 36 READ (CARDS(I),700) KEYCRD 700 FORMAT (A6) DO 12 J=1, 9 IF (KEYCRD.EQ.KEY(J)) THEN GOTO (3,4,5,6,7,8,9,10,11),J 3 READ (CARDS(I),701) LS 701 FORMAT(10X,L20) IF (.NOT.(LS)) THEN PRINT *, ' ABORT....TAPE NOT FITS SIMPLE FORMAT' STOP 'TAPE FORMAT ERROR' ENDIF GOTO 13 4 READ (CARDS(I),702) BITPIX 702 FORMAT (10X,I20) IF (.NOT.((BITPIX.EQ.16).OR.(BITPIX.EQ.32))) THEN PRINT *, ' ABORT....BITPIX NOT 16' STOP ENDIF GOTO 13 5 READ (CARDS(I),702) NAXIS IF ((NAXIS.LT.1).OR.(NAXIS.GT.2)) THEN PRINT *, ' ABORT....WRONG NUMBER OF AXES ',NAXIS STOP 'AXIS ERROR' ENDIF GOTO 13 6 READ (CARDS(I),702) NAXIS1 GOTO 13 7 READ (CARDS(I),702) NAXIS2 GOTO 13 8 READ (CARDS(I),703) OBJECT 703 FORMAT (11X,A28) GOTO 13 9 READ (CARDS(I),704) BSCALE 704 FORMAT (10X,E20.13) GOTO 13 10 READ (CARDS(I),704) BZERO GOTO 13 11 ENDHEAD=.TRUE. ENDIF 12 CONTINUE 13 WRITE (1,100) CARDS(I) 100 FORMAT (A80) IF (ENDHEAD) GOTO 605 IF ((I.EQ.36).AND.(.NOT.(ENDHEAD))) GOTO 2 14 CONTINUE C C...............................................OPEN OUTPUT PIXEL FILE C C NOW WE WILL OPEN THE OUTPUT PIXEL FILES. C C USING THE NAXIS1 VALUE OBTAINED FROM THE FITS HEADER WE CAN C MAKE A BINARY OUTPUT FILE THAT HOLDS ONE RASTER ACROSS THE C CCD IN EACH RECORD. C C NOTE AGAIN, THAT A MORE GERERAL READER WOULD QUERY THE USER FOR OR C THE FILENAME. C 605 CONTINUE OPEN (UNIT=2, FILE='/FITS PIX A', STATUS='UNKNOWN') CALL FILEINF(IRET,'RECFM','F','LRECL',4*NAXIS1) OPEN (UNIT=3, FILE='/FITS BIN A', STATUS='UNKNOWN', & FORM='UNFORMATTED') C C.....................................READ IN DATA AND WRITE OUT TO DISC C C NOW WE READ IN THE PIXEL DATA. C C FIRST WE READ IN A WHOLE TAPE BLOCK (2880 BYTES) INTO ARRAY IBUF. C C THEN DEPENDING ON WHETHER THE TAPE CONTAINED 16BIT OR 32BIT DATA ATA C WE EVALUATE THE VALUE XIZ, THE "SCALED" NUMBER THAT WAS WRITTEN EN C TO TAPE. C C LASTLY WE APPLY THE SCALE FACTORS READ FROM THE TAPE HEADER TO O C THE NUMBER XIZ TO GET THE FINAL NUMBER STORED IN ARRAY LINOUT . C C WHEN ARRAY LINOUT IS FILLED THEN IT IS WRITTEN TO THE OUTPUT C FILES FITS PIX A AND FITS BIN A C 15 IB=1441 DO 17 IY=1, 573 DO 16 IX=1, 384 IF (IB.GT.1440) THEN READ(5,601)IBUF NREC=NREC+1 601 FORMAT(36(40A2)) IB=1 ENDIF IZ=IBUF(IB) XIZ=IZ IB=IB+1 IF (BITPIX.EQ.32) THEN XIZ=IBUF(IB)+XIZ*BIT16 IB=IB+1 ENDIF XIZ=XIZ*BSCALE+BZERO LINOUT(IX)=XIZ 16 CONTINUE WRITE(2,690) (LINOUT(I),LINOUT(I+1),LINOUT(I+2), & LINOUT(I+3),LINOUT(I+4),LINOUT(I+4), & LINOUT(I+5),LINOUT(I+6),I=1,NAXIS1,8) WRITE(3) (LINOUT(I),I=1,NAXIS1) 690 FORMAT(8(F9.1,1X)) 17 CONTINUE CLOSE (UNIT=1) CLOSE (UNIT=2) CLOSE (UNIT=3) C STOP END C C C SUBROUTINE A2E(CHAR,ILEN) C C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C C This subroutine will convert the ASCII string passed in variable C CHAR into a EBCDIC stirng and return the converted string in the C the same variable. C C ILEN is the length of the ASCII string. C C************** DO NOT CONVERT THIS SUBROUTINE TO UPPERCASE!!! ****** C************** THE LOWERCASE CHARACTERS IN THE "DATA ASCII" ****** C************** LINE MUST BE IN MIXED CASE ****** C C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C INTEGER ILEN,INDEX CHARACTER*128 ASCII CHARACTER*1 CHAR(ILEN),T(4), TARRAY(128) EQUIVALENCE (T(1),INDEX),(tarray(1),ascii) DATA ASCII /' !"#$%& ()*+,-./01234 &56789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ{\}›_`abcdefghijklmnopqrstuv &wxyz{º}~ '/ INDEX=0 DO 10 I=1,ILEN T(4)=CHAR(I) 10 CHAR(I)=TARRAY(INDEX) RETURN END