pro CONV_UNIX_VAX, variable, SOURCE_ARCH=source
;
;***********************************************************************
;+
; NAME:
;       CONV_UNIX_VAX
; PURPOSE:
;       To convert Unix IDL data types to VAX IDL data types.  Currently
;       assumes the Unix IDL data type is IEEE standard in either
;       big-endian or little-endian format.
;
; CALLING SEQUENCE:
;       CONV_UNIX_VAX, variable, [ SOURCE_ARCH = ]
;
; PARAMETERS:
;       variable - The data variable to be converted.  This may be a scalar
;               or an array.  Valid datatypes are integer, longword,
;               floating point, and double precision. The result of the 
;               conversion is passed back in the original variable.
; OPTIONAL INPUT KEYWORD:  
;       SOURCE_ARCH = name (string) of source architecture
;               if using this function on a VAX, otherwise
;               !VERSION.ARCH is used to determine the conversion.
;               **If run on a VAX, the default is to assume the source to be
;               a little-endian machine with IEEE floating point
;               (e.g. MIPSEL or Alpha***).
; EXAMPLE:
; RESTRICTIONS:
;       Requires that data be from IEEE standard Unix machines
;       (e.g. SUN, MIPSEL, or Alpha).
; EXAMPLE:
;       Read a 100 by 100 matrix of floating point numbers from a data
;       file created on a Sun.  Then convert the matrix values into
;       VAX format.
;
;       IDL> openr,1,'vax_float.dat
;       IDL> data = fltarr(100,100)
;       IDL> forrd,1,data
;       IDL> CONV_UNIX_VAX,data,SOURCE_ARCH='sparc'
;
; MODIFICATION HISTORY:
;       Version 1       By John Hoegy           13-Jun-88
;       04-May-90 - WTT:  Created CONV_UNIX_VAX from VAX2SUN,
;                         reversing floating point procedure.
;       Modified  P. Keegstra             September 1994
;           Implemented MIPSEL and ALPHA architecture,
;           distinguishing VMS and OSF
;       Modified  P. Keegstra             February 1995
;           Added 386 PC based architectures
;-                                   
;****************************************************************************
;
;  Check to see if VARIABLE is defined.
;
 if N_params() LT 1 then begin
        print,'Syntax - CONV_UNIX_VAX, variable, [ SOURCE_ARCH = ]
        return
 endif

 if n_elements(variable) eq 0 then begin
        print,'*** VARIABLE not defined, routine CONV_UNIX_VAX.'
        retall
endif

if N_elements( source ) EQ 1 then arch = source  else arch = !VERSION.ARCH 
 little_endian = 0

CASE arch OF

"sparc":                    ;Assume default big-endian

; Demo version of PV-WAVE for Linux reports itself as arch="i386".
; IDL for MS-WINDOWS reports itself as arch="3.1".

'i386': little_endian = 1
'3.1':  little_endian = 1
'mipsel': little_endian = 1
'386':  little_endian = 1
'386i': little_endian = 1
'x86': little_endian = 1

"vax": BEGIN
        message,"machine is VAX, " + $
                "will assume source has little-endian " + $
                "architecture and IEEE floating point",/CONTIN
        little_endian = 1
        END

"alpha": BEGIN
        IF !VERSION.OS EQ 'vms' THEN BEGIN
;            message,"machine is alpha running VMS, " + $
;                    "will assume source has little-endian " + $
;                    "architecture and IEEE floating point",/CONTIN
            little_endian = 1
        ENDIF ELSE little_endian = 1
        END

else:                  ;default is to assume big endian architecture
ENDCASE
;
 if little_endian then begin
        swap_ints = 0
        swap_float = 2
 endif else begin
        swap_ints = 1
        swap_float = 1
 endelse
 
var_chars = size(variable)
var_type = var_chars(var_chars(0)+1)

case var_type of
  1: return                             ; byte

  2: BEGIN                              ; integer
        if (swap_ints GT 0) then begin
                byteorder,variable,/SSWAP
        endif
     END

  3: BEGIN                              ; longword
        if (swap_ints GT 0) then begin
                byteorder,variable,/LSWAP
        endif
     END

  4: BEGIN                              ; floating point
        scalar = (var_chars(0) eq 0)
        var_elems = long(var_chars(var_chars(0)+2))
        byte_elems = var_elems*4L
        byte_eq = byte(variable, 0, byte_elems)
    ;
        if (swap_float GT 1) then byteorder, byte_eq, /LSWAP
    ;
        i1 = lindgen(byte_elems/4L)*4L
        i2 = i1 + 1L
        biased = byte((byte_eq(i1) AND '7F'X) * 2) OR byte(byte_eq(i2)/128L)
        i = where(biased ne 0)
        if (i(0) ne -1) then biased(i) = byte(biased(i) + 2)
        byte_eq(i1) = byte(byte_eq(i1) AND '80'X) OR byte(biased/2)
        byte_eq(i2) = byte(byte_eq(i2) AND '7F'X) OR byte(biased*128)
    ; 
    ; swap bytes
    ;
        byte_elems = byte_elems + 3L
        byteorder, byte_eq, /SSWAP
;
        if scalar then begin
           tmp = fltarr(1)
           tmp(0) = float(byte_eq, 0, var_elems)
           variable = tmp(0)
           endif else variable(0) = float(byte_eq, 0, var_elems)
        return
     END

  5: BEGIN                      ; double precision
        var_elems = long(var_chars(var_chars(0)+2))
        byte_elems = var_elems*8L
        scalar = (var_chars(0) eq 0)
        if scalar then begin
             tmp = dblarr(1)
             tmp(0) = variable
             byte_eq = byte(tmp, 0, byte_elems)
        endif else byte_eq = byte(variable, 0, byte_elems)
    ;
    ;  Bring it up to at least a double-precision level.
    ;
        byte_elems = byte_elems + 7L
        i1 = lindgen(byte_elems/8L)*8L
        i2 = i1 + 1L
        i3 = i2 + 1L
        i4 = i3 + 1L
        i5 = i4 + 1L
        i6 = i5 + 1L
        i7 = i6 + 1L
        i8 = i7 + 1L
    ;
        if (swap_float GT 1) then begin
             byte_eq2     = bytarr(byte_elems)
             byte_eq2(i1) = byte_eq(i8)
             byte_eq2(i2) = byte_eq(i7)
             byte_eq2(i3) = byte_eq(i6)
             byte_eq2(i4) = byte_eq(i5)
             byte_eq2(i5) = byte_eq(i4)
             byte_eq2(i6) = byte_eq(i3)
             byte_eq2(i7) = byte_eq(i2)
             byte_eq2(i8) = byte_eq(i1)
             byte_eq      = byte_eq2
        endif
    ;
    ;  Bring it up to at least a double-precision level.
    ;

        exponent = fix( ((byte_eq(i1) AND '7F'X)*16) OR $
                    ((byte_eq(i2) AND 'F0'X)/16) )
        i = where(exponent ne 0)
        if (i(0) ne -1) then exponent(i) = exponent(i) + 128 - 1022
        tmp1 = byte_eq(i8)
        byte_eq(i8) = ((byte_eq(i7) and '1f'x)*8) or ((tmp1 and 'e0'x)/32)
        tmp2 = byte_eq(i7)
        byte_eq(i7) = (tmp1 and '1f'x)*8
        tmp3 = byte_eq(i6)
        byte_eq(i6) = ((byte_eq(i5) and '1f'x)*8) or ((tmp3 and 'e0'x)/32)
        tmp1 = byte_eq(i5)
        byte_eq(i5) = ((tmp3 and '1f'x)*8) or ((tmp2 and 'e0'x)/32)
        tmp2 = byte_eq(i4)
        byte_eq(i4) = ((byte_eq(i3) and '1f'x)*8) or ((tmp2 and 'e0'x)/32)
        tmp3 = byte_eq(i3)
        byte_eq(i3) = ((tmp2 and '1f'x)*8) or ((tmp1 and 'e0'x)/32)
        tmp1 = byte_eq(i2)
        byte_eq(i2) = (byte_eq(i1) and '80'x) or byte((exponent and 'fe'x)/2)
        byte_eq(i1) = byte((exponent and '1'x)*128) or ((tmp1 and 'f'x)*8) or $
             ((tmp3 and 'e0'x)/32)
;
        if scalar then begin
           tmp = dblarr(1)
           tmp(0) = double(byte_eq, 0, var_elems)
           variable = tmp(0)
           endif else variable(0) = double(byte_eq, 0, var_elems)
        return
     END

  6: begin                      ; complex
       rvalue = float(variable)
       ivalue = imaginary(variable)
       conv_unix_vax,rvalue, SOURCE_ARCH = source
       conv_unix_vax,ivalue, SOURCE_ARCH = source
       variable = complex(rvalue,ivalue)
       end
 
  7: return                     ; string

  else: begin                   ; unknown
       print,'*** Data type ' + strtrim(var_type,2) + $
                  ' unknown, routine CONV_UNIX_VAX.'
       retall
       end
  endcase
return
end