more routines from SSW gen that are needed for running the idl compar…

…ison tests

fiasco/tests/idl/ssw_gen_functions/datatype.pro

@@ -0,0 +1,156 @@
+function datatype,var, flag0, descriptor=desc, help=hlp, Tname = tname
+ ;+
+; NAME: 
+;      DATATYPE()
+;
+; PURPOSE: 
+;      Returns the data type of a variable.
+;
+; EXPLANATION: 
+;      This routine returns the data type of a variable in a format specified
+;      by the optional flag parameter.    Can also be used to emulate, in 
+;      earlier versions of IDL, the SIZE(/TNAME) option introduced in V5.1.
+;
+;      This routine was originally derived from the JHUAPL library ***but has 
+;      diverged from the JHUAPL library for the newer data types.***  For this
+;      reason DATATYPE is no longer used in any other procedure in the IDL 
+;      Astronomy Library.
+; CALLING SEQUENCE         : 
+;      Result = DATATYPE( VAR  [, FLAG , /TNAME, /DESC ] )
+;
+; INPUTS: 
+;     VAR     = Variable to examine, no restrictions
+;
+; OPTIONAL INPUT PARAMETERS: 
+;     FLAG  = Integer between 0 and 3 giving the output format flag as 
+;             explained below.  The default is 0.
+;     /DESC = If set, then return a descriptor for the given variable.  If the
+;             variable is a scalar the value is returned as a string.  If it is
+;             an array a description is returned just like the HELP command 
+;             gives.  Ex:'
+;             IDL> print, datatype(fltarr(2,3,5),/desc) gives the string
+;                           'FLTARR(2,3,5)'
+;     /TNAME - If set, then returns a identical result to the use of the /TNAME
+;                keyword to the SIZE() function in IDL V5.2 and later.   
+;               Overrides the value of FLAG.
+;     /HELP    = If set, then a short explanation is printed out.
+;
+; OUTPUT PARAMETERS: 
+;       The result of the function is the either a string or integer giving the
+;       data type of VAR.  Depending on the value of FLAG or /TNAME, the result
+;       will be one of the values from the following table:
+;
+;      FLAG = 0       FLAG = 1       FLAG = 2    FLAG = 3      /TNAME
+;
+;      UND            Undefined        0          UND          UNDEFINED  
+;      BYT            Byte             1          BYT          BYTE
+;      INT            Integer          2          INT          INT
+;      LON            Long             3          LON          LONG
+;      FLO            Float            4          FLT          FLOAT
+;      DOU            Double           5          DBL          DOUBLE
+;      COM            Complex          6          COMPLEX      COMPLEX
+;      STR            String           7          STR          STRING
+;      STC            Structure        8          STC          STRUCT
+;      DCO            DComplex         9          DCOMPLEX     DCOMPLEX
+;      PTR            Pointer         10          PTR          POINTER
+;      OBJ            Object          11          OBJ          OBJREF
+;      UIN            UInt            12          UINT         UINT
+;      ULN            ULong           13          ULON         ULONG
+;      L64            Long64          14          LON64        LONG64
+;      U64            ULong64         15          ULON64       ULONG64
+;
+;
+; REVISION HISTORY: 
+;       Original Version: R. Sterner, JHU/APL, 24 October 1985.
+;       Major rewrite, add /TNAME keyword, unsigned and 64 bit datatypes
+;       W. Landsman   August 1999
+;       Zarro (SM&A/GSFC) - November 2001, replace error stops by continues
+;-
+;-------------------------------------------------------------
+
+
+        if (N_params() lt 1) or keyword_set(hlp) then begin
+          print,' Datatype of variable as a string (3 char or spelled out).'
+          print,' typ = datatype(var, [flag])'
+          print,'   var = variable to examine.         in'
+          print,'   flag = output format flag (def=0). in'
+          print,'   typ = datatype string or number.   out'
+          print,'      flag=0    flag=1      flag=2  flag=3      /TNAME'
+          print,'      UND       Undefined   0       UND         UNDEFINE'
+          print,'      BYT       Byte        1       BYT         BYTE'
+          print,'      INT       Integer     2       INT         INT'
+          print,'      LON       Long        3       LON         LONG'
+          print,'      FLO       Float       4       FLT         FLOAT'
+          print,'      DOU       Double      5       DBL         DOUBLE'
+          print,'      COM       Complex     6       COMPLEX     COMPLEX'
+          print,'      STR       String      7       STR         STRING'
+          print,'      STC       Structure   8       STC         STRUCT'
+          print,'      DCO       DComplex    9       DCOMPLEX    DCOMPLEX'
+          print,'      PTR       Pointer    10       PTR         POINTER'
+          print,'      OBJ       Object     11       OBJ         OBJREF'
+          print,'      UIN       UInt       12       UINT        UINT'
+          print,'      ULO       ULong      13       ULON        ULONG'
+          print,'      L64       Long64     14       LON64       LONG64'
+          print,'      U64       ULong64    15       ULON64      ULONG64'
+          print,' Keywords:'                                     
+          print,'  /TNAME - Identical output to SIZE(/TNAME) '
+          print,'  /DESCRIPTOR returns a descriptor for the given variable.'
+          print,'     If the variable is a scalar the value is returned as'
+          print,'     a string.  If it is an array a description is return'
+          print,'     just like the HELP command gives.  Ex:'
+          print,'     datatype(fltarr(2,3,5),/desc) gives'
+          print,'       FLTARR(2,3,5)  (flag always defaults to 3 for /DESC).'
+          return, -1
+        endif 
+
+ s_tname = ['UNDEFINE', 'BYTE','INT','LONG','FLOAT','DOUBLE','COMPLEX',$
+            'STRING','STRUCT','DCOMPLEX','POINTER','OBJREF','UINT','ULONG', $
+            'LONG64','ULONG64']
+
+ s_flag0 =  ['UND','BYT','INT','LON','FLO','DOU','COM','STR','STC','DCO','PTR',$
+             'OBJ','UIN','ULO','L64','U64']
+
+ s_flag1 = ['Undefined','Byte','Integer','Long','Float','Double','Complex', $
+            'String','Structure','DComplex','Pointer','Object','UInt','ULong',$
+            'Long64','ULong64']
+
+ s_flag3 = [ 'UND','BYT','INT','LON','FLT','DBL','COMPLEX','STR','STC', $
+            'DCOMPLEX','PTR','OBJ','UINT','ULON','LON64','ULON64']
+
+       s = size(var)
+       stype =  s[s[0]+1]
+        if stype GT N_elements(s_tname) then begin
+         message,'ERROR - Unrecognized IDL datatype',/cont
+         stype=0
+        endif
+
+        if keyword_set(TNAME) then return, s_tname[stype]          
+
+        if N_params() lt 2 then flag0 = 0      ; Default flag.
+        if keyword_set(desc) then flag0 = 3
+
+       case flag0 of 
+
+  0: return, s_flag0[stype]
+  1: return, s_flag1[stype]
+  2: return, stype
+  3: typ = s_flag3[stype]
+  else: message,'ERROR - Flag parameter must be between 0 and 3'
+  endcase 
+
+ if keyword_set(desc) then begin
+          if stype EQ 0 then begin
+           message,'ERROR - Input variable is undefined',/cont
+           return,'Undefined'
+          endif
+          if s[0] eq 0 then return,strtrim(var,2)       ; Return scalar desc.
+          aa = typ+'ARR('
+          for i = 1, s[0] do begin                      
+            aa = aa + strtrim(s[i],2)                 
+            if i lt s[0] then aa = aa + ','          
+            endfor                                     
+          aa = aa+')'                                   
+          return, aa
+        endif else return,typ
+
+   end

fiasco/tests/idl/ssw_gen_functions/default.pro

@@ -0,0 +1,50 @@
+;+
+; Project     : SOHO - CDS     
+;                   
+; Name        : DEFAULT
+;               
+; Purpose     : Supply default values for variables
+;               
+; Explanation : If the first parameter is not defined, it is
+;		set to the value of the second parameter.
+;               
+; Use         : DEFAULT,VARIABLE,DEFAULT_VALUE
+;    
+; Inputs      : VARIABLE : The variable that could take on the default value
+;
+;		DEFAULT_VALUE : The default value.
+;               
+; Opt. Inputs : None.
+;               
+; Outputs     : None.
+;               
+; Opt. Outputs: None.
+;               
+; Keywords    : None.
+;
+; Calls       : None.
+;
+; Common      : None.
+;               
+; Restrictions: None.
+;               
+; Side effects: None.
+;               
+; Category    : Utility, Misc.
+;               
+; Prev. Hist. : Taken from my private library.
+;
+; Written     : Stein Vidar Hagfors Haugan
+;               
+; Modified    : Never
+;
+; Version     : 1, 4-Sept-1995
+;-            
+
+PRO DEFAULT,VAR,VAL
+
+If N_params() lt 2 then message,"Use: DEFAULT,VARIABLE,DEFAULT_VALUE"
+
+IF N_ELEMENTS(VAR) EQ 0 THEN VAR=VAL
+
+END

fiasco/tests/idl/ssw_gen_functions/delvarx.pro

@@ -0,0 +1,52 @@
+;+
+; NAME: 
+;	DELVARX
+; PURPOSE: 
+; 	Undefine up to 10 variables for memory management (can call from routines) 
+; EXPLANATION:
+;	Similar to the intrinsic DELVAR function, but can be used from any calling level.
+;   (DELVAR can only be used at the main level.)    Note, however, that unlike DELVAR,
+;   DELVARX does not delete the variables (they will be listed as UNDEFINED when 
+;   viewed with HELP), but only makes them undefined and frees their memory
+;   
+;   Also look at the similar Coyote routine UNDEFINE
+;          http://www.idlcoyote.com/programs/undefine.pro
+; 
+; CALLING SEQUENCE:
+; 	DELVARX,  p0, [p1, p2......p9]
+;
+; INPUTS: 
+;	p0, p1...p9 - variables to delete
+;
+; OBSOLETE KEYWORD:
+;   /FREE_MEM -  free memory associated with pointers and objects.  Since this is now the 
+;                 DELVARX default (since 2012) this keyword now does nothing.   
+;           
+; METHOD: 
+;	Uses HEAP_FREE and PTR_NEW(/NO_COPY) to undefine variables and free memory   
+;
+; REVISION HISTORY:
+;	Copied from the Solar library, written by slf, 25-Feb-1993
+;	Added to Astronomy Library,  September 1995
+;   Modified, 26-Mar-2003, Zarro (EER/GSFC) 26-Mar-2003
+;       - added FREE_MEM to free pointer/objects
+;   Modified, 28-Jan-2012, E. Rykoff (SLAC), W. Landsman - 
+;               replace EXECUTE calls with SCOPE_VARFETCH.
+;   Clarified documentation  W. Landsman Sep 2018
+;-
+
+PRO delvarx, p0,p1,p2,p3,p4,p5,p6,p7,p8,p9,free_mem = free_mem
+
+ npar = N_params()      ; Number of parameters
+ pp = 'p'+strtrim(indgen(npar),1)
+
+ for i=0,npar-1 do begin
+    defined = N_elements( SCOPE_VARFETCH(pp[i],LEVEL=0))   
+    if LOGICAL_TRUE(defined) then $
+             heap_free, ptr_new( SCOPE_VARFETCH(pp[i],LEVEL=0),/no_copy) 
+
+ endfor
+
+ return
+ end
+

fiasco/tests/idl/ssw_gen_functions/get_uniq.pro

@@ -0,0 +1,58 @@
+;+
+; Project     : HESSI
+;
+; Name        : get_uniq
+;
+; Purpose     : return unique elements of an array
+;
+; Category    : utility
+;;
+; Syntax      : IDL> out=get_uniq(in)
+;
+; Inputs      : IN = array to search
+;
+; Outputs     : OUT = unique elements
+;
+; Optional Out: SORDER = sorting index
+;
+; Keywords    : NO_CASE: case insensitive ordering on strings
+;               COUNT: # of uniq values
+;				EPSILON:  positive number ge 0, for gt 0 the difference between
+;				two consecutive numbers must be gt epsilon for them to be unique.
+;
+; History     : Written 20 Sept 1999, D. Zarro, SM&A/GSFC
+;		25-Aug-2006, richard.schwartz@gsfc.nasa.gov;  added an epsilon tolerance
+;			     for determining floats to be the same value
+;             : 16-Sep-2014 - S.Freeland - uniq -> ssw_uniq.pro (avoid
+;                             8.3/exelis uniq collision)
+;             : 18-Jul-2018 - return null for non-existent input
+;
+; Contact     : dzarro@solar.stanford.edu
+;-
+
+function get_uniq,array,sorder,no_case=no_case,count=count, epsilon=epsilon
+
+count=0
+sorder=-1
+if ~exist(array) then return,null()
+sorder=0
+if n_elements(array) eq 1 then begin
+ count=1
+ return,array[0]
+endif
+
+sorted=0b
+if keyword_set(no_case) then begin
+ if is_string(array) then begin
+  sorder=ssw_uniq([strlowcase(array)],sort([strlowcase(array)]))
+  sorted=1b
+ endif
+endif
+
+if ~sorted then sorder=ssw_uniq([array],sort([array]), epsilon=epsilon)
+
+count=n_elements(sorder)
+if count eq 1 then sorder=sorder[0]
+
+return,array[sorder]
+end

fiasco/tests/idl/ssw_gen_functions/null.pro

@@ -0,0 +1,27 @@
+;+
+; Project     : VSO
+;
+; Name        : NULL
+;
+; Purpose     : Return !NULL 
+;
+; Category    : Utility
+;
+; Inputs      : None
+;
+; Outputs     : !NULL = '' if !NULL not defined
+;
+; Keywords    : None
+;
+; History     : 9-Dec-2015, Zarro (ADNET) - written
+;
+; Contact     : DZARRO@SOLAR.STANFORD.EDU
+;-
+
+function null
+
+null=''
+defsysv,'!null',exists=i
+if i eq 0 then defsysv,'!null',''
+return,!null
+end