;function fits_open_datacube ; ;PURPOSE: ; To open a .fits file that will contain a X x Y x T x N datacube that ; can be appended with the asic_fits_append_datacube function or read ; into an array in memory. ; ; The file is opened, a header is written, and then it is closed. It is ; then left open for appending. ; ;INPUTS: ; FitsFileName - the name of the file to be opened ; ; FitsHeader - the fits header. It must contain the minimum amount ; of information necessary to write a fits file. ; ; ReadWrite - String containing either 'Read' or 'Write' to determine ; the mode. 'Write' will overwrite the file specified if ; it already exists. ; ;OUTPUTS: ; ; Position = the number of bytes at which the header ends and the data ; begins ;KEYWORDS: ; ; BZeroSet: int ; 0 - Use BZero value from header (If not present, data will be signed integers) ; 1 - Force BZero = 32768 for unsigned integers ; ;NOTE: in order to view the contents of the FCB structure, type ; ; help, /structure, FCB ; ; COMMON VARIABLES: ; NOTE: You Must include ; 'Common FitsCube, FCB, unit' ; at the beginning of program to make the common variables ; accesible outside of this function ; ;AUTHOR: ; Lance Simms, Stanford University 12/08 ; function Fits_Open_Datacube, FitsFileName, FCB, FitsHeader, ReadWrite, BZeroSet = BZeroSet if N_Elements(BZeroSet) eq 0 then BZeroSet = 0 ;Error Handling on_ioerror,ioerror get_lun,unit If ReadWrite eq 'Write' then begin ;Open the file for writing If !version.os eq 'vms' then $ openw, unit, FitsFileName, /block, /none,2880 $ else openw, unit, FitsFilename EndIf else if ReadWrite eq 'Read' then begin ;Open the file for reading openr, unit, FitsFileName, /block EndIf File = fstat(unit) nbytes_in_file = double(File.size) n = 100 xtension = strarr(n) extname = strarr(n) extver = lonarr(n) extlevel = lonarr(n) gcount = lonarr(n) pcount = lonarr(n) bitpix = lonarr(n) naxis = lonarr(n) axis = lonarr(20,n) start_header = lonarr(n) ; starting byte in file for header start_data = lonarr(n) ; starting byte in file for data Extend_Number = 0 ; current extention number being position = 0L ; current byte position in file start = Position ;*********************************FORM HEADER IF ReadWrite eq 'Write' then begin ;Form a Header from the input data Header = strarr(1) Header(0) = 'END ' Header = [FitsHeader, Header] ;Write the Header Information to the first block last = where(strmid(Header,0,8) eq 'END ') n = last[0] + 1 byte_header = replicate(32b,80,n) for i=0,n-1 do byte_header[0,i] = byte(Header[i]) writeu, File.unit,byte_header ; pad header to 2880 byte records npad = 2880 - (80L*n mod 2880) if npad eq 2880 then npad = 0 if (npad gt 0) then writeu, File.unit,replicate(32b,npad) nbytes_header = npad + n*80 ;**********************************GET INFO FROM HEADER EndIf Else if ReadWrite eq 'Read' then begin main_header = 1 ; first header in file flag h = bytarr(80,36,/nozero) ; read buffer point_lun,unit,position start = position ; loop on header blocks ; first_block = 1 ; first block in header flag repeat begin If position+2879 ge nbytes_in_file then begin if Extend_Number eq 0 then begin message = 'EOF ecountered while reading header' endif print,'EOF encountered reading extension header' print,'Only '+strtrim(Extend_Number-1,2) + $ ' extensions processed' goto, done_headers endif readu,unit,h position = position + 2880 hdr = string(h>32b) endline = where(strmid(hdr,0,8) eq 'END ',nend) if nend gt 0 then hdr = hdr[0:endline[0]] if first_block then begin ; check for valid header (SIMPLE keyword must be first for PDU and ; XTENSION keyword for the extensions. ; header = hdr keyword = strmid(header[0],0,8) if (Extend_Number eq 0) and $ (keyword ne 'SIMPLE ') then begin message = 'Invalid header, no SIMPLE keyword' endif if (Extend_Number gt 0) and $ (keyword ne 'XTENSION') then begin print,'Invalid extension header encountered' print,'XTENSION keyword missing' print,'Only '+strtrim(Extend_Number-1,2) + $ ' extensions processed' goto,done_headers endif end else header = [header,hdr] first_block = 0 end until (nend gt 0) EndIf ;Grab the Keywords from the formed header; make default for ;Bzero if it's not defined in the header Xtension[Extend_Number] = strtrim(sxpar(header,'xtension')) St = sxpar(header,'extname') if !err lt 0 then st = '' Extname[Extend_Number] = strtrim(st,2) Extver[Extend_Number] = sxpar(header,'extver') Extlevel[Extend_Number] = sxpar(header,'extlevel') Gcount[Extend_Number] = sxpar(header,'gcount') Pcount[Extend_Number] = sxpar(header,'pcount') Random_Groups = sxpar(header,'groups') Bitpix[Extend_Number] = sxpar(header,'bitpix') Bzero = sxpar(header,'bzero', Count = N_bzero) ; A line to deal with improper setting of BZERO for Unsigned Integers If (N_bzero eq 0 and bitpix(0) eq 16 and BZeroSet eq 1) then Bzero = 32768 else Bzero = BZero Nax = sxpar(header,'naxis') Naxis[Extend_Number] = nax If nax gt 0 then for i=1,nax do $ axis[i-1,Extend_Number] = sxpar(header,'naxis'+strtrim(i,2)) Start_Data[Extend_Number] = position Start_header[Extend_Number] = start Hmain = Header ;No extensions for now NExtend = -1 Nx = 0 FCB = { FileName :FitsFileName, $ Unit :Unit, $ NExtend :NExtend[0:nx], $ Xtension :Xtension[0:nx], $ ExtName :ExtName[0:nx], $ ExtVer :ExtVer[0:nx], $ BitPix :BitPix[0:nx], $ NAxis :NAxis[0:nx], $ Axis :Axis[*,0:nx], $ Start_Header : Start_Header[0:nx], $ Start_Data : Start_Data[0:nx], $ HMain : HMain[0:nx], $ Open_for_write : 2, $ Last_Extension : -1, $ Random_Groups : Random_Groups, $ BZero : BZero } !err = 1 FitsHeader = Hmain return, position ; point at end of file in /extend done_headers: print, 'done' ioerror: message = !err_string print, 'There was an error in opening your file : ' + FitsFilename stop return, 1 End