C+ C NAME: C smei_frm_fts C PURPOSE: C Write SMEI CCD frame to Fits file C CALLING SEQUENCE: subroutine smei_frm_fts(cFile,nx,ny,nb,frame,hdr) C INPUTS: C cFile*(*) character fully-qualified Fits filename C nx integer 1st array dimension C ny integer 2nd array dimension C nb integer 2=int 2; 4=int 4; -4=float C frame(*) real CCD frame array C hdr(*) double precision CCD header array C INCLUDE: include 'filparts.h' include 'smei_frm_hdr.h' include 'smei_frm_layout.h' C MODIFICATION HISTORY: C 2008-JUN, Paul Hick (UCSD/CASS; pphick@ucsd.edu) C Added documentation. C- character cFile*(*) integer nx integer ny integer nb real frame(*) double precision hdr(*) character cSay*12 /'smei_frm_fts'/ character cSeverity /'E'/ logical bSimple /.TRUE./ ! Conforms to FITS standard integer nAxis / 2/ ! Two dim array integer nAxes(2) logical bExtend /.FALSE./ ! Allows FITS extensions logical anyf integer bzero /32768/ integer*2 ifrm(SMEI__FRM_NPIX) integer jfrm(SMEI__FRM_NPIX) equivalence (jfrm,ifrm) character cStr*(FIL__LENGTH) integer tt(2) integer Time2Str iBitPix = 8*nb nAxes(1) = nx nAxes(2) = ny iU = iGetLun(cFile) istat = 0 ! Initialize to zero ! Stays zero as long as there are no FITS errors ! Open a new Fits file. call FTINIT(iU, cFile, 1, istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) ! Write primary header call FTPHPR(iU, bSimple, iBitPix, nAxis, nAxes, 0, 1, bExtend, istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) call FTPKYJ(iU ,'FRAME_NR', nint(hdr(SMEI__HDR_FRAME_NR)), 'frame number', istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) call FTPKYJ(iU ,'CAMERA' , nint(hdr(SMEI__HDR_CAMERA)), 'camera', istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) call FTPKYJ(iU ,'ROI_MAP' , nint(hdr(SMEI__HDR_ROI_MAP)), 'roi map', istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) call FTPKYJ(iU ,'MODE' , nint(hdr(SMEI__HDR_MODE)), 'mode', istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) call FTPKYJ(iU ,'N_DATA' , nint(hdr(SMEI__HDR_N_DATA)), 'nr data values', istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) call smei_hdr_time(hdr, tt) ! Frame time i = Time2Str(SMEI__UT_FORMAT,tt,cStr) ! Start of frame call FTPKYS(iU ,'TIME', cStr(:i), 'UT time', istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) call FTPKYJ(iU ,'EXPOSURE', nint(hdr(SMEI__HDR_EXPOSURE)), 'exposure in secs', istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) ! First ephemeris section: optical axis parameters. call smei_frm_fts_axis(iU, hdr) ! Quaternion (refined quaternion RQUAT is not used yet> call FTPKND(iU,'QUAT',1,4,hdr(SMEI__HDR_QUAT),7,'quaternion&', istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) call FTPKND(iU,'RQUAT',1,4,hdr(SMEI__HDR_RQUAT),7,'refined quaternion&', istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) ! Second ephemeris section: Sun, Moon and Venus ! This also files SMEI__HDR_ECLIPSE and SMEI__HDR_SHADOW. These ! are written into the Fits file by the smei_frm_fts_base call below. call smei_frm_fts_eph(iU, hdr) call FTPKYJ(iU ,'OBS_FRAM', nint(hdr(SMEI__HDR_OBS_FRAME)), 'frame sequence number', istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) call FTPKYJ(iU ,'BOS_CHAN', nint(hdr(SMEI__HDR_BOS_CHANGE)), 'BOS change state counter', istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) call FTPKYJ(iU ,'FIXED_BI', nint(hdr(SMEI__HDR_FIXED_BITS)), 'bits fixed from parity checks', istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) call FTPKYJ(iU ,'CORRUPT_', nint(hdr(SMEI__HDR_CORRUPT_PIX)), 'corrupt pixels at end', istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) call FTPKYJ(iU ,'CR_HITS' , nint(hdr(SMEI__HDR_CR_HITS)), 'pixels blanked as cosmic rays', istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) call FTPKYD(iU ,'ATTITUDE', hdr(SMEI__HDR_ATTITUDE_DT),7, 'quat time discrepancy', istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) call FTPKYD(iU ,'CCD_TEMP', hdr(SMEI__HDR_CCD_TEMP),7, 'CCD temperature', istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) call FTPKYD(iU ,'BAD_DATA', hdr(SMEI__HDR_BAD_DATA),7, 'bad data flag', istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) ! Write all base related header names call smei_frm_fts_base(iU, hdr) call smei_hdr_str(SMEI__HDR_TLM_FILE, hdr, cStr) i = iSetFileSpec(cStr) i = iGetFileSpec(FIL__NAME,FIL__NAME,cStr) call FTPKYS(iU ,'TLM_FILE', cStr, 'telemetry file', istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) call smei_hdr_str(SMEI__HDR_L1A_FILE, hdr, cStr) i = iSetFileSpec(cStr) i = iGetFileSpec(FIL__NAME,FIL__NAME,cStr) call FTPKYS(iU ,'L1A_FILE', cStr, 'L1A file', istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) call FTPKYJ(iU ,'L1A_PNTR', nint(hdr(SMEI__HDR_L1A_PNTR)), 'L1A file pointer', istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) if (nb .eq. 2) then do i=1,nx*ny if (frame(i) .ge. 0) then ifrm(i) = nint(frame(i)-bzero) else ifrm(i) = nint(frame(i)+bzero) end if end do call FTPPRI(iU, 0, 1, nx*ny, ifrm, istat) ! Write integer*2 array if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) ! BZERO marks the data array as unsigned integer ! If this keyword is added prior to writing the array this doesn't work. call FTPKYJ(iU ,'BZERO' , bzero, 'unsigned integer', istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) else if (nb .eq. 4) then do i=1,nx*ny jfrm(i) = nint(frame(i)) end do call FTPPRJ(iU, 0, 1, nx*ny, jfrm, istat) ! Write integer*4 array if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) else call FTPPRE(iU, 0, 1, nx*ny, frame, istat) ! Write real*4 array if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) end if call FTCLOS(iU,istat) if (istat .ne. 0) call say_fts(cSay,cSeverity,istat) iU = iFreeLun(iU) return end