;------------------------------------------------------------------------------ ; NAME: READPDS ; ; PURPOSE: To read a PDS file into IDL data and label variables ; ; CALLING SEQUENCE: Result = READPDS (Filename [, HEADPDS=, /SILENT, /NOSCALE]) ; ; INPUTS: ; Filename: Scalar string containing the name of the PDS file to read ; OUTPUTS: ; Result: PDS data structure constructed from designated record ; ; OPTIONAL INPUTS: ; SILENT: suppresses any informational (non-warning and non-error) ; message from the procedure ; NOSCALE: does not perform scaling and offset of values in image ; or qube arrays, default is to scale and offset; scaling is ; never performed in other objects. ; ; OPTIONAL OUTPUTS: ; HEADPDS: If this keyword is supplied then the PDS label array ; constructed from designated record will be returned in the ; keyword ; ; EXAMPLES: ; To read a PDS file TEST.LBL into an IDL image array, img: ; IDL> img = READPDS ("TEST.LBL", /SILENT) ; IDL> help, /STRUCTURE, img ; OBJECTS INT 1 ; IMAGE LONG [200,200] ; To read a PDS file with multiple objects and include the label: ; IDL> data = READPDS ("MULTIPLE.LBL", HEADPDS=label, /SILENT) ; IDL> help, /STRUCTURE, data ; OBJECTS INT 2 ; TABLE STRUCT -> ARRAY[1] ; IMAGE STRUCT -> ARRAY[1] ; IDL> help, /STRUCTURE, label ; LABEL STRING = Array[200] ; ; PROCEDURES USED: ; Functions: ARRCOLPDS, ARRCOLASCPDS, HEADPDS, OBJPDS, IMAGEPDS, TASCPDS, ; TBINPDS, QUBEPDS, READSPREADSHEET, READHISTORY, READHISTOGRAM. ; ; MODIFICATION HISTORY: ; Written by: J. Koch [Aug 01, 1994] ; Some sections adapted from READFITS.PRO by Wayne Landsman. ; Re-written by: P. Khetarpal [Feb 01, 2003] ; Last modified: L. Nagdimunov [Jul 07, 2015] ; ; This modification history is for this file only. For complete list of ; modifications to this and all other readPDS related routines, see the ; changelog.txt file. ;------------------------------------------------------------------------------ ;- level 1 -------------------------------------------------------------------- ;------------------------------------------------------------------------------ ; precondition: label is a viable PDS label. ; postcondition: all viable PDS object names, label indices, and count ; are extracted from the label, and if there is an error, the flag ; field of the returned struct is set to -1. function get_all_objects, label ; initialize variable struct = {flag:1} ; extract all objects using objpds: obj = objpds(label, "ALL") ; external routine if (obj.flag eq -1) then begin ;A.Cardesin 27-04-2005 ;Modified: filename printing was incorrect. (unknown for this procedure) print, "Error: no viable PDS object found in file" ; + filename goto, endfunction endif ; check if there exist BIT_COLUMN, BIT_ELEMENT, and CONTAINER objects ; in the PDS file: ; 2010Jul, smartinez: Updated to handle BIT_COLUMN/CONTAINER objects ;bcol = objpds(label, "BIT_COLUMN") ; external routine ;cont = objpds(label, "CONTAINER") ; external routine belem = objpds(label, "BIT_ELEMENT") ; external routine if (belem.flag eq 1) then begin print, "Error: BIT_ELEMENT object" + $ " found. Currently not supported by PDSREAD." goto, endfunction endif ; temporary assignment of object structure's fields: tmpcount = obj.count tmparray = obj.array tmpindex = obj.index ; go through the object indices, if multiple, and remove sub-objects: ; Modified by L.Nagdimunov 23Jan2015 ; Added ability to read HISTORY objects if (obj.count gt 0) then begin flag = 0 rcount = 0 stopcount = where (obj.array eq 'HISTORY') eq -1 ? 0 : 1 while (~flag) do begin ; obtain end_index for current objarray object: endindex = get_index(label, tmpindex[rcount]) if (endindex eq -1) then goto, endfunction ; obtain all indices where sub objects are not included: pos = where (tmpindex le tmpindex[rcount] or tmpindex gt endindex) ; set object index and object array to appropriate values: tmpindex = tmpindex[pos] tmparray = tmparray[pos] tmpcount = n_elements(tmparray) ; increment count rcount += 1 stopcount += 1 ; set flag to 1 if all objects have been accounted for: if (stopcount eq tmpcount) then begin flag = 1 endif endwhile endif struct = create_struct(struct, "array", tmparray, "index", tmpindex, $ "count", stopcount) return, struct endfunction: struct.flag = -1 return, struct end ;------------------------------------------------------------------------------ ; precondition: fname is a viable PDS file name, label is a viable PDS label, ; st contains either the value of 0 or 1, and objindex is a valid index ; for a table, series, spectrum, or palette object. ; postcondition: the tabular data is read from the file specified by fname ; and returned to the main block after checking for interchange format ; keyword. function dotable, fname, label, st, objindex ; obtain interchange format keyword from label: inform = pdspar (label, "INTERCHANGE_FORMAT", COUNT=cnt, INDEX=index) if (cnt eq 0) then begin print, "Error: " + fname + " missing required INTERCHANGE_FORMAT " + $ "keyword." return, -1 endif ; determine the index of the interchange format keyword that belongs ; to the current tabular object: w = where (index gt objindex) ; select which subroutine to pass on the tasks: if (strpos (inform(w[0]),"ASCII") gt -1) then begin data = (~st) ? tascpds (fname, label, objindex) : $ tascpds (fname, label, objindex, /silent) endif else if (strpos (inform(w[0]),"BINARY") gt -1) then begin data = (~st) ? tbinpds (fname, label, objindex) : $ tbinpds (fname, label, objindex, /silent) endif else begin print, "Error: Invalid PDS table interchange format" + inform[0] return, -1 endelse return, data end ;------------------------------------------------------------------------------ ; precondition: fname is a viable PDS file name, label is a viable PDS label, ; st contains either the value of 0 or 1, and objindex is a valid index ; for an array or collection object. ; postcondition: the array of collection data is read from the file specified ; by fname and returned to the main block after checking for interchange ; format keyword. function doarrcol, fname, label, st, objindex ; obtain interchange format keyword from label: inform = pdspar (label, "INTERCHANGE_FORMAT", COUNT=cnt, INDEX=index) if (cnt eq 0) then begin print, "Error: " + fname + " missing required INTERCHANGE_FORMAT " + $ "keyword." return, -1 endif ; determine the index of the interchange format keyword that belongs ; to the current tabular object: w = where (index gt objindex) ; select which subroutine to pass on the tasks: if (strpos (inform(w[0]),"ASCII") gt -1) then begin data = (~st) ? arrcolascpds (fname, label, objindex) : $ arrcolascpds (fname, label, objindex, /silent) endif else if (strpos (inform(w[0]),"BINARY") gt -1) then begin data = (~st) ? arrcolpds (fname, label, objindex) : $ arrcolpds (fname, label, objindex, /silent) endif else begin print, "Error: Invalid PDS table interchange format" + inform[0] return, -1 endelse return, data end ;- level 0 -------------------------------------------------------------------- function readpds, filename, HEADPDS = headpds, SILENT = silent, NOSCALE = noscale, HISTOGRAM = histogram forward_function headpds ; error protection: on_error, 2 ;A.Cardesin 24 February 2006 ; FORCE IDL PATH to look first into the correct directory ; this is done to avoid name conflicts with other programs sSBNIDLpath=FILE_DIRNAME(FILE_WHICH('readpds.pro',/INCLUDE_CURRENT_DIR)) case STRUPCASE(!version.os_name) of 'MICROSOFT WINDOWS' : sep=';' 'SOLARIS' : sep = ':' 'LINUX' : sep=':+' 'MAC OS X' : sep=':' else : endcase ;Save current path to recover it in the end sSavePath = !PATH !PATH=sSBNIDLpath+sep+!PATH ; check for number of parameters in function call: if (n_params() lt 1) then begin print, "Syntax Error: result = READPDS (filename [, HEADPDS=, /SILENT, /NOSCALE])" return, -1 endif ; check for headpds, silent, noscale, and histogram keyword presence: hdr = arg_present(headpds) st = keyword_set(silent) noscale = keyword_set(noscale) hist = keyword_set(histogram) ; save file name savefile = filename ; obtain PDS label: label = (~st) ? headpds(filename) : headpds(filename, /silent) if (label[0] eq "-1") then return, -1 if (hdr) then headpds = label ; reset file name filename = savefile ; obtain all viable objects from label array: objects = get_all_objects(label) ; subroutine if (objects.flag eq -1) then return, -1 objarray = objects.array objindex = objects.index objcount = objects.count ; initialize the object structure result = create_struct("objects", objcount) ; create a flag variable to hold a flag for IMAGE objects whether to ; perform multiple object read or not flag_image = 1 ;/******* start loop to populate viable objects ************************/ for i = 0, objcount - 1 do begin obj = objarray[i] ; check for each type of OBJECT and read the individual objects: ; first check whether multiple object read flag is set to -1 ; if flag eq 1 then process IMAGE objects, and set flag to 0: ; test to process IMAGE: pos = strpos(obj, "IMAGE") if ((pos[0] gt -1) && flag_image) then begin if (~st) then begin data = (~noscale) ? imagepds(filename, label) : $ imagepds(filename, label, /noscale) endif else begin data = (~noscale) ? imagepds(filename, label, /silent) : $ imagepds(filename, label, /silent, /noscale) endelse flag_image = 0 data_name = size(data, /type) eq 8 ? "IMAGES" : objarray[i] result = create_struct (result, data_name, data) endif ; test to process ARRAY and COLLECTION: pos_array = strpos(obj, "ARRAY") pos_collection = strpos(obj, "COLLECTION") if ((pos_array gt -1) || (pos_collection gt -1)) then begin data = doarrcol (filename, label, st, objindex[i]) ; subroutine ; data = (~st) ? arrcolpds(filename, label, objindex[i]) : $ ; arrcolpds(filename, label, objindex[i], /silent) result = create_struct (result, objarray[i], data) endif ; test to process QUBE: if (strpos(obj, "QUBE") gt -1) then begin if (~st) then begin data = (~noscale) ? qubepds(filename, label) : $ qubepds(filename, label, /noscale) endif else begin data = (~noscale) ? qubepds(filename, label, /silent) : $ qubepds(filename, label, /silent, /noscale) endelse result = create_struct (result, objarray[i], data) endif ; test to process TABLE, SERIES, PALETTE, or SPECTRUM: if ((strpos(obj, "TABLE") gt -1) || $ (strpos(obj, "SERIES") gt -1) || $ (strpos(obj, "PALETTE") gt -1) || $ (strpos(obj, "SPECTRUM") gt -1)) then begin data = dotable (filename, label, st, objindex[i]) ; subroutine result = create_struct (result, objarray[i], data) endif ;Modified A.Cardesin 04Jan2006 ;Added readSpreadsheet routine if (strpos(obj, "SPREADSHEET") gt -1) then begin data = (~st) ? readspreadsheet(filename, label, objindex[i], /PRINT_TIME) : $ readspreadsheet(filename, label, objindex[i], /silent) result = create_struct (result, objarray[i], data) endif ; Modified by L.Nagdimunov 23Jan2015 ; Added ability to read HISTORY objects if obj eq "HISTORY" then begin data = (~st) ? readhistory(filename, label, objindex[i]) : $ readhistory(filename, label, objindex[i], /silent) result = create_struct (result, objarray[i], data) endif endfor ; display the contents of the structure if not in silent mode: if (~st) then help, /st, result ;A.Cardesin 24 February 2006 ;Recover idl path !PATH = sSavePath if hist EQ 0 then return, result if hist EQ 1 then begin numtab = -1.1 while numtab LT 1 or (numtab-floor(numtab)) NE 0 do begin read,"How many tabs do you want to run Histogram with (Integer >= 1): ",numtab endwhile histogram,result,numtab endif end