c************
c  Description:	Convert data types between foreign representations on
c		VAX, IEEE, and EEEI engines through conditional compiles. 
c
c		DTJ 5/3/95:  Merged the various convert modules into
c		  this file, convertf.for, and convertc.c .
c
c  Author:	JGS  6-1-94
c
c  $Revision: 1.1 $
c  $Modtime:   01 Nov 1995 16:01:58  $
c
c  Modules:
c	M$CONVERT	- convert from foreign to native representation
c	M$CONVERT_TO	- convert native data to foreign representation
c
c************
c
	subroutine M$CONVERT (machine, buffer, type, n)

	character*1 machine,type
	byte        buffer(*)
	integer*4   n

	if (machine.eq.'I') then
#if _IEEE
#elif _VAX
	  if (type.eq.'F') then
	    call F_IEEE2VAX (buffer, n)
	  elseif (type.eq.'L') then
	    call SWAP4 (buffer, n)
	  elseif (type.eq.'I') then
	    call SWAP2 (buffer, n)
	  elseif (type.eq.'D') then
	    call D_IEEE2VAX (buffer, n)
	  elseif (type.eq.'B' .or. type.eq.'A' .or. type.eq.'O' .or. 
     &		  type.eq.'P' .or. type.eq.'U') then
	  else
	    call M$ERROR ('Unconvertable type in M$CONVERT: '//type)
	  endif
#elif _EEEI
	  if (type.eq.'F') then
	    call SWAP4 (buffer, n)
	  elseif (type.eq.'L') then
	    call SWAP4 (buffer, n)
	  elseif (type.eq.'I') then
	    call SWAP2 (buffer, n)
	  elseif (type.eq.'D') then
	    call SWAP8 (buffer, n)
	  elseif (type.eq.'B' .or. type.eq.'A' .or. type.eq.'O' .or. 
     &		  type.eq.'P' .or. type.eq.'U') then
	  else
	    call M$ERROR ('Unconvertable type in M$CONVERT: '//type)
	  endif
#endif
	elseif (machine.eq.'V') then
#if _IEEE
	  if (type.eq.'F') then
	    call F_VAX2IEEE (buffer, n)
	  elseif (type.eq.'L') then
	    call SWAP4 (buffer, n)
	  elseif (type.eq.'I') then
	    call SWAP2 (buffer, n)
	  elseif (type.eq.'D') then
	    call D_VAX2IEEE (buffer, n)
	  elseif (type.eq.'B' .or. type.eq.'A' .or. type.eq.'O' .or. 
     &		  type.eq.'P' .or. type.eq.'U') then
	  else
	    call M$ERROR ('Unconvertable type in M$CONVERT: '//type)
	  endif
#elif _VAX
#elif _EEEI
	  if (type.eq.'F') then
	    call F_VAX2EEEI (buffer, n)
	  elseif (type.eq.'L') then
	  elseif (type.eq.'I') then
	  elseif (type.eq.'D') then
	    call D_VAX2EEEI (buffer, n)
	  elseif (type.eq.'B' .or. type.eq.'A' .or. type.eq.'O' .or. 
     &		  type.eq.'P' .or. type.eq.'U') then
	  else
	    call M$ERROR ('Unconvertable type in M$CONVERT: '//type)
	  endif
#endif
	elseif (machine.eq.'E' .or. machine.eq.'T') then
#if _IEEE
	  if (type.eq.'F') then
	    if (machine.eq.'T') call F_TI2EEEI (buffer, n)
	    call SWAP4 (buffer, n)
	  elseif (type.eq.'L') then
	    call SWAP4 (buffer, n)
	  elseif (type.eq.'I') then
	    call SWAP2 (buffer, n)
	  elseif (type.eq.'D') then
	    call SWAP8 (buffer, n)
	  elseif (type.eq.'B' .or. type.eq.'A' .or. type.eq.'O' .or. 
     &		  type.eq.'P' .or. type.eq.'U') then
	  else
	    call M$ERROR ('Unconvertable type in M$CONVERT: '//type)
	  endif
#elif _VAX
	  if (type.eq.'F') then
	    if (machine.eq.'T') call F_TI2EEEI (buffer, n)
	    call F_EEEI2VAX (buffer, n)
	  elseif (type.eq.'L') then
	  elseif (type.eq.'I') then
	  elseif (type.eq.'D') then
	    call D_EEEI2VAX (buffer, n)
	  elseif (type.eq.'B' .or. type.eq.'A' .or. type.eq.'O' .or. 
     &		  type.eq.'P' .or. type.eq.'U') then
	  else
	    call M$ERROR ('Unconvertable type in M$CONVERT: '//type)
	  endif
#elif _EEEI
	  if (type.eq.'F' .and. machine.eq.'T') then
	    call F_TI2EEEI (buffer, n)
	  endif
#endif
	elseif (machine.eq.'C') then
#if _IEEE
	  if (type.eq.'F') then
	    call F_CRAY2IEEE (buffer, n)
	  elseif (type.eq.'L') then
	  elseif (type.eq.'I') then
	  elseif (type.eq.'D') then
	    call D_CRAY2IEEE (buffer, n)
	  elseif (type.eq.'B' .or. type.eq.'A' .or. type.eq.'O' .or. 
     &		  type.eq.'P' .or. type.eq.'U') then
	  else
	    call M$ERROR ('Unconvertable type in M$CONVERT: '//type)
	  endif
#elif _VAX
	  if (type.eq.'F') then
	    call F_CRAY2VAX (buffer, n)
	  elseif (type.eq.'L') then
	    call SWAP4 (buffer, n)
	  elseif (type.eq.'I') then
	    call SWAP2 (buffer, n)
	  elseif (type.eq.'D') then
	    call D_CRAY2VAX (buffer, n)
	  elseif (type.eq.'B' .or. type.eq.'A' .or. type.eq.'O' .or. 
     &		  type.eq.'P' .or. type.eq.'U') then
	  else
	    call M$ERROR ('Unconvertable type in M$CONVERT: '//type)
	  endif
#elif _EEEI
	  if (type.eq.'F') then
	    call F_CRAY2EEEI (buffer, n)
	  elseif (type.eq.'L') then
	    call SWAP4 (buffer, n)
	  elseif (type.eq.'I') then
	    call SWAP2 (buffer, n)
	  elseif (type.eq.'D') then
	    call D_CRAY2EEEI (buffer, n)
	  elseif (type.eq.'B' .or. type.eq.'A' .or. type.eq.'O' .or. 
     &		  type.eq.'P' .or. type.eq.'U') then
	  else
	    call M$ERROR ('Unconvertable type in M$CONVERT: '//type)
	  endif
#endif
	else
	  call M$ERROR ('Unknown machine type in M$CONVERT: '//machine)
	endif
	return
	end


	subroutine M$CONVERT_TO (machine, buffer, type, n)

	character*1 machine,type
	byte        buffer(*)
	integer*4   n

	if (machine.eq.'I') then
#if _IEEE
#elif _VAX
	  if (type.eq.'F') then
	    call F_VAX2IEEE (buffer, n)
	  elseif (type.eq.'L') then
	    call SWAP4 (buffer, n)
	  elseif (type.eq.'I') then
	    call SWAP2 (buffer, n)
	  elseif (type.eq.'D') then
	    call D_VAX2IEEE (buffer, n)
	  elseif (type.eq.'B' .or. type.eq.'A' .or. type.eq.'O' .or. 
     &		  type.eq.'P' .or. type.eq.'U') then
	  else
	    call M$ERROR ('Unconvertable type in M$CONVERT_TO: '//type)
	  endif
#elif _EEEI
	  if (type.eq.'F') then
	    call SWAP4 (buffer, n)
	  elseif (type.eq.'L') then
	    call SWAP4 (buffer, n)
	  elseif (type.eq.'I') then
	    call SWAP2 (buffer, n)
	  elseif (type.eq.'D') then
	    call SWAP8 (buffer, n)
	  elseif (type.eq.'B' .or. type.eq.'A' .or. type.eq.'O' .or. 
     &		  type.eq.'P' .or. type.eq.'U') then
	  else
	    call M$ERROR ('Unconvertable type in M$CONVERT_TO: '//type)
	  endif
#endif
	elseif (machine.eq.'V') then
#if _IEEE
	  if (type.eq.'F') then
	    call F_IEEE2VAX (buffer, n)
	  elseif (type.eq.'L') then
	    call SWAP4 (buffer, n)
	  elseif (type.eq.'I') then
	    call SWAP2 (buffer, n)
	  elseif (type.eq.'D') then
	    call D_IEEE2VAX (buffer, n)
	  elseif (type.eq.'B' .or. type.eq.'A' .or. type.eq.'O' .or. 
     &		  type.eq.'P' .or. type.eq.'U') then
	  else
	    call M$ERROR ('Unconvertable type in M$CONVERT_TO: '//type)
	  endif
#elif _VAX
#elif _EEEI
	  if (type.eq.'F') then
	    call F_EEEI2VAX (buffer, n)
	  elseif (type.eq.'L') then
	  elseif (type.eq.'I') then
	  elseif (type.eq.'D') then
	    call D_EEEI2VAX (buffer, n)
	  elseif (type.eq.'B' .or. type.eq.'A' .or. type.eq.'O' .or. 
     &		  type.eq.'P' .or. type.eq.'U') then
	  else
	    call M$ERROR ('Unconvertable type in M$CONVERT_TO: '//type)
	  endif
#endif
	elseif (machine.eq.'E' .or. machine.eq.'T') then
#if _IEEE
	  if (type.eq.'F') then
	    call SWAP4 (buffer, n)
	  elseif (type.eq.'L') then
	    call SWAP4 (buffer, n)
	  elseif (type.eq.'I') then
	    call SWAP2 (buffer, n)
	  elseif (type.eq.'D') then
	    call SWAP8 (buffer, n)
	  elseif (type.eq.'B' .or. type.eq.'A' .or. type.eq.'O' .or. 
     &		  type.eq.'P' .or. type.eq.'U') then
	  else
	    call M$ERROR ('Unconvertable type in M$CONVERT_TO: '//type)
	  endif
#elif _VAX
	  if (type.eq.'F') then
	    call F_VAX2EEEI (buffer, n)
	    if (machine.eq.'T') call F_EEEI2TI (buffer, n)
	  elseif (type.eq.'L') then
	  elseif (type.eq.'I') then
	  elseif (type.eq.'D') then
	    call D_VAX2EEEI (buffer, n)
	  elseif (type.eq.'B' .or. type.eq.'A' .or. type.eq.'O' .or. 
     &		  type.eq.'P' .or. type.eq.'U') then
	  else
	    call M$ERROR ('Unconvertable type in M$CONVERT_TO: '//type)
	  endif
#elif _EEEI
	  if (type.eq.'F' .and. machine.eq.'T') then
	    call F_EEEI2TI (buffer, n)
	  endif

#endif
	elseif (machine.eq.'C') then
#if _IEEE
	  if (type.eq.'F') then
	    call F_IEEE2CRAY (buffer, n)
	  elseif (type.eq.'L') then
	  elseif (type.eq.'I') then
	  elseif (type.eq.'D') then
	    call D_IEEE2CRAY (buffer, n)
	  elseif (type.eq.'B' .or. type.eq.'A' .or. type.eq.'O' .or. 
     &		  type.eq.'P' .or. type.eq.'U') then
	  else
	    call M$ERROR ('Unconvertable type in M$CONVERT_TO: '//type)
	  endif
#elif _VAX
	  if (type.eq.'F') then
	    call F_VAX2CRAY (buffer, n)
	  elseif (type.eq.'L') then
	    call SWAP4 (buffer, n)
	  elseif (type.eq.'I') then
	    call SWAP2 (buffer, n)
	  elseif (type.eq.'D') then
	    call D_VAX2CRAY (buffer, n)
	  elseif (type.eq.'B' .or. type.eq.'A' .or. type.eq.'O' .or. 
     &		  type.eq.'P' .or. type.eq.'U') then
	  else
	    call M$ERROR ('Unconvertable type in M$CONVERT_TO: '//type)
	  endif
#elif _EEEI
	  if (type.eq.'F') then
	    call F_EEEI2CRAY (buffer, n)
	  elseif (type.eq.'L') then
	    call SWAP4 (buffer, n)
	  elseif (type.eq.'I') then
	    call SWAP2 (buffer, n)
	  elseif (type.eq.'D') then
	    call D_EEEI2CRAY (buffer, n)
	  elseif (type.eq.'B' .or. type.eq.'A' .or. type.eq.'O' .or. 
     &		  type.eq.'P' .or. type.eq.'U') then
	  else
	    call M$ERROR ('Unconvertable type in M$CONVERT_TO: '//type)
	  endif
#endif
	else
	  call M$ERROR ('Unknown machine type in M$CONVERT_TO: '//machine)
	endif
	return
	end



c ====================================== Low-Level Conversion Routines
c
c The following routines exist at this low level.
c Every one of these symbols must be available to all platforms.
c Compilation directives are used to select how each is implemented.
c
c In some cases a given O/S may have an optimized conversion, which
c would be used over the general conversion.
c
c In some cases the algorithm will have been implemented in C, and
c can be found in convertc.c .
c
c    SWAP2
c    SWAP4
c    SWAP8
c
c    F_IEEE2VAX
c    F_VAX2IEEE
c    D_IEEE2VAX
c    D_VAX2IEEE
c
c    F_CRAY2IEEE
c    F_IEEE2CRAY
c    D_CRAY2IEEE
c    D_IEEE2CRAY


c---------------------------------------------------------------------
c
c  CRAY - Cray Big-Endian Integer;
c  IEEE - IEEE-754 Big-Endian Integer (e.g. Sun)
c
c	bit: 31                     0
c	    +------------------------+
c	    |  b0    b1    b2    b3  | <-byte order
c	    +------------------------+
c
c	bit: 15         0
c	    +------------+
c	    |  b0    b1  | <- byte order
c	    +------------+
c
c
c  VAX  - VAX/VMS Little-Endian Integer;
c  EEEI - IEEE-754 Little-Endian Integer (e.g. IBM PC):
c
c	bit: 31                     0
c	    +------------------------+
c	    |  b3    b2    b1    b0  | <-byte order
c	    +------------------------+
c
c	bit: 15         0
c	    +------------+
c	    |  b1    b0  | <- byte order
c	    +------------+
c
c
c  Hence convert EEEI/VAX integer <-> CRAY/IEEE integer by REVERSING BYTES 
c                                                          ===============
c
c---------------------------------------------------------------------

#if _SUN|_LINX|_SOL|_IRIX

c
c SWAP2, SWAP4, and SWAP8 are located on the C side for SUN, LINX, SOL & IRIX.
c They are left here in FORTRAN for the DEC platforms (VMS, VMSX, OSF)
c because DEC's FORTRAN compiler is better at unrolling loops.
c Convex C-Series FORTRAN compiler is better at unrolling loops.

#else

c Swap bytes to convert between VAX and IEEE short integer
	subroutine SWAP2 (bv, n)
	byte	   bv(*), b
	integer*4  n, n2, n4, i
	n2 = n/2*2
	n4 = n2*2
	do i = 1,n4,4	! in groups of 4 bytes for speed
	  b = bv(i)
	  bv(i) = bv(i+1)
	  bv(i+1) = b
	  b = bv(i+2)
	  bv(i+2) = bv(i+3)
	  bv(i+3) = b
	enddo
	if (n2.ne.n) then	! leftover
	  b = bv(n4+1)
	  bv(n4+1) = bv(n4+2)
	  bv(n4+2) = b
	endif
	return
	end

c Swap bytes to convert between VAX and IEEE long integer
	subroutine SWAP4 (bv, n)
	byte	   bv(*),b
	integer*4  n, i
	do i = 1,n*4,4
	  b = bv(i)
	  bv(i) = bv(i+3)
	  bv(i+3) = b
	  b = bv(i+1)
	  bv(i+1) = bv(i+2)
	  bv(i+2) = b
	enddo
	return
	end

c Swap bytes to convert between EEEI and IEEE double precision
	subroutine SWAP8 (dv, n)
	real*8     dv(*), d1, d2
	integer*4  n, i
	byte	   b1(8), b2(8)
	equivalence (b1,d1), (b2,d2)
	do i = 1,n
	  d1 = dv(i)
	  b2(1) = b1(8)
	  b2(2) = b1(7)
	  b2(3) = b1(6)
	  b2(4) = b1(5)
	  b2(5) = b1(4)
	  b2(6) = b1(3)
	  b2(7) = b1(2)
	  b2(8) = b1(1)
	  dv(i) = d2
	enddo
	return
	end

#endif


c---------------------------------------------------------------------
c
c  IEEE - IEEE-754 Big-Endian Floating Point (e.g. Sun):
c
c	bit: 31                       0
c	    +---+----------+-----------+
c	    | s |  e7..e0  |  f22..f0  | 	<-- Single Precision
c	    +---+----------+-----------+
c	      1    8 bits     23 bits
c
c	Value = (-1)**s x 2**(e-127) x 1.f
c
c	Range = min: 1.17*10**-38  (s=0/1, e=1, f=0)
c		max: 3.40*10**+38  (s=0/1, e=254, f=all ones)
c
c
c	bit: 63                       0
c	    +---+-----------+-----------+
c	    | s |  e10..e0  |  f51..f0  | 	<-- Double Precision
c	    +---+-----------+-----------+
c	      1    11 bits     52 bits
c
c	Value = (-1)**s x 2**(e-1023) x 1.f
c
c	Range = min: 2.25*10**-308  (s=0/1, e=1, f=0)
c		max: 1.80*10**+308  (s=0/1, e=2046, f=all ones)
c
c
c	Special Cases:
c
c	    Denormalized	e=0, f=nonzero
c
c	    Signed Zero	  +0	e=0, f=0, s=0
c			  -0    e=0, f=0, s=1
c
c	    Infinity      +inf	e=all ones, f=0, s=0
c		          -inf  e=all ones, f=0, s=1
c
c	    Not a Number	e=all ones, f=nonzero
c
c
c	Byte Order:
c	    +--------------------------+
c	    | b0 b1 b2 b3 b4 b5 b6 b7  |
c	    +--------------------------+
c
c
c  VAX - VAX/VMS Little-Endian Floating Point:
c
c	bit: 31                       0
c	    +---+----------+-----------+
c	    | s |  e7..e0  |  f22..f0  | 	<-- Single Precision
c	    +---+----------+-----------+
c	      1    8 bits     23 bits
c
c	Value = (-1)**s x 2**(e-128) x .1f
c
c
c	bit: 63                       0
c	    +---+----------+-----------+
c	    | s |  e7..e0  |  f54..f0  | 	<-- Double Precision (D-format)
c	    +---+----------+-----------+
c	      1    8 bits     55 bits
c
c	Value = (-1)**s x 2**(e-128) x .1f
c
c	Range = min: 0.29*10**-38  (s=0/1, e=1, f=0)
c		max: 1.70*10**+38  (s=0/1, e=255, f=all ones)
c
c
c	bit: 63                       0
c	    +---+-----------+-----------+
c	    | s |  e10..e0  |  f51..f0  | 	<-- Double Precision (G-format)
c	    +---+-----------+-----------+
c	      1    11 bits     52 bits
c
c	Value = (-1)**s x 2**(e-1024) x .1f
c
c	Range = min: 0.56*10**-308  (s=0/1, e=1, f=0)
c		max: 0.9*10**+308   (s=0/1, e=2047, f=all ones)
c
c
c	Special Cases:
c
c	    Zero	  0	e=0, f=0, s=0
c
c	    Reserved		e=0, f=0, s=1
c
c
c	Byte Order:
c	    +--------------------------+
c	    | b1 b0 b3 b2 b5 b4 b7 b6  |
c	    +--------------------------+
c	(This peculiar byte order is because VAX floating point originated
c        in 16-bit PDP-11 days, so that 16-bit words are swapped.  E.g. note 
c        comment in VAX FORTRAN User Manual p. 10-13 that sign bit of floating 
c        point number is not the same bit as sign bit of integer*4 number.)
c
c
c  Simple math shows that the VAX value is 4 times the IEEE value for both 
c  single precision and G-format double precision.  Hence:
c
c  To convert IEEE to VAX single precision, SWAP BYTE PAIRS and MULT BY 4
c                                           =============================
c
c  For double precision, SWAP BYTE PAIRS, MULT BY 4 and CONVERT VAX D to G
c                        =================================================
c
c---------------------------------------------------------------------

c ============================= Single Precision IEEE/VAX Conversions =====

#if _LINX|_OSF

c
c  The code for the 'F' IEEE/VAX conversions is located on the C side
c  for LINX and OSF.
c

#elif _IRIX

c
c  The code for the 'F' IEEE/VAX conversions is located on the C side
c  for IRIX.
c
c  IRIX supplies MIPS2VAX and VAX2MIPS functions, but C code is used
c  for portability.

#elif _CNVX

c
c  The code for the 'F' IEEE/VAX conversions is located on the C side
c  for CNVX.
c

#elif _VMSX

c
c  The Alpha has specialized routines for these conversions; use them.
c

c Swap byte pairs and tweak exponent to convert IEEE to VAX floating point
	subroutine F_IEEE2VAX (fv, n)
	include '($cvtdef)'
	real*4    fv(*)
	integer*4  n, i, stat, CVT$CONVERT_FLOAT, opt
	opt = cvt$m_round_to_nearest .or. cvt$m_big_endian
	do i = 1,n
	  stat = CVT$CONVERT_FLOAT (fv(i),%val(cvt$k_ieee_s),
     &		fv(i),%val(cvt$k_vax_f), %val(opt) )
	  if (.not.stat) call LIB$SIGNAL (%val(stat))
	enddo	
	return
	end


c Tweak exponent and swap byte pairs to convert VAX to IEEE floating point
	subroutine F_VAX2IEEE (fv, n)
	include '($cvtdef)'
	real*4     fv(*)
	integer*4  n, i, stat, CVT$CONVERT_FLOAT, opt
	opt = cvt$m_round_to_nearest .or. cvt$m_big_endian
	do i = 1,n
	  stat = CVT$CONVERT_FLOAT (fv(i),%val(cvt$k_vax_f),
     &		fv(i),%val(cvt$k_ieee_s), %val(opt) )
	  if (.not.stat) call LIB$SIGNAL (%val(stat))
	enddo	
	return
	end

#elif _SUN|_SOL

c These platforms do not have specialized 'F' conversion
c for IEEE/VAX, and historically have done it explicitly in FORTRAN.

c Tweak exponent and swap byte pairs to convert IEEE to VAX floating point
	subroutine F_IEEE2VAX (fv, n)
	real*4    fv(*), f1, f2
	integer*4 n, i
	byte      b1(4), b2(4)
	equivalence (f1,b1), (f2,b2)
	do i = 1,n
	  f1 = fv(i)*4
	  b2(1) = b1(2)
	  b2(2) = b1(1)
	  b2(3) = b1(4)
	  b2(4) = b1(3)
	  fv(i) = f2
	enddo	
	return
	end


c Swap byte pairs and tweak exponent to convert VAX to IEEE floating point
	subroutine F_VAX2IEEE (fv, n)
	real*4     fv(*), f1, f2
	integer*4  n, i
	byte       b1(4), b2(4)
	equivalence (f1,b1), (f2,b2)
	do i = 1,n
	  f1 = fv(i)
	  b2(1) = b1(2)
	  b2(2) = b1(1)
	  b2(3) = b1(4)
	  b2(4) = b1(3)
	  fv(i) = f2/4
	enddo	
	return
	end

#elif _VMS

c Swap byte pairs and tweak exponent to convert IEEE to VAX floating point
	subroutine F_IEEE2VAX (fv, n)
	real*4    fv(*), f1, f2
	integer*4 n, i
	byte      b1(4), b2(4)
	equivalence (f1,b1), (f2,b2)
	external  lib$fixup_flt
	call lib$establish (lib$fixup_flt)
	do i = 1,n
	  f1 = fv(i)
	  b2(1) = b1(2)
	  b2(2) = b1(1)
	  b2(3) = b1(4)
	  b2(4) = b1(3)
	  fv(i) = f2*4
	enddo	
	return
	end


c Tweak exponent and swap byte pairs to convert VAX to IEEE floating point
	subroutine F_VAX2IEEE (fv, n)
	real*4     fv(*), f1, f2
	integer*4  n, i
	byte       b1(4), b2(4)
	equivalence (f1,b1), (f2,b2)
	do i = 1,n
	  f1 = fv(i)/4
	  b2(1) = b1(2)
	  b2(2) = b1(1)
	  b2(3) = b1(4)
	  b2(4) = b1(3)
	  fv(i) = f2
	enddo	
	return
	end

#endif



c ============================= Double Precision IEEE/VAX Conversions =====


#if _LINX|_OSF

c
c  The code for the 'D' IEEE/VAX conversions is located on the C side
c  for LINX and OSF.
c

#elif _IRIX

c
c  The code for the 'D' IEEE/VAX conversions is located on the C side
c  for IRIX.
c
c  IRIX supplies MIPS2VAX and VAX2MIPS functions, but C code is used
c  for portability.

#elif _CNVX

c
c  The code for the 'D' IEEE/VAX conversions is located on the C side
c  for CNVX.
c

#elif _VMSX

c
c  The Alpha has specialized routines for these conversions; use them.
c

c ***** Major assumption: all VAX double precisions are D-Floating *****
c Swap bytes, tweak exponent, then go to VAX D floating point to convert 
c IEEE to VAX double precision
	subroutine D_IEEE2VAX (dv, n)
	include '($cvtdef)'
	real*8     dv(*)
	integer*4  n, i, stat, CVT$CONVERT_FLOAT, opt
	opt = cvt$m_truncate .or. cvt$m_err_underflow .or. cvt$m_big_endian
	do i = 1,n
	  stat = CVT$CONVERT_FLOAT (dv(i),%val(cvt$k_ieee_t),
     &		dv(i),%val(cvt$k_vax_d), %val(opt) )
	  if (.not.stat) call LIB$SIGNAL (%val(stat))
	enddo	
	return
	end


c ***** Major assumption: all VAX double precisions are D-Floating *****
c Go to VAX G floating point, tweak exponent, then swap bytes to convert VAX 
c to IEEE double precision
	subroutine D_VAX2IEEE (dv, n)
	include '($cvtdef)'
	real*8       dv(*)
	integer*4  n, i, stat, CVT$CONVERT_FLOAT, opt
	opt = cvt$m_truncate .or. cvt$m_err_underflow .or. cvt$m_big_endian
	do i = 1,n
	  stat = CVT$CONVERT_FLOAT (dv(i),%val(cvt$k_vax_d),
     &		dv(i),%val(cvt$k_ieee_t), %val(opt) )
	  if (.not.stat) call LIB$SIGNAL (%val(stat))
	enddo	
	return
	end

#elif _SUN|_SOL

c The Sun also has special routines for double prec. IEEE/VAX conversion

c ***** Major assumption: all VAX double precisions are D-Floating *****
c Use SunOS convert_external routine to convert from VAX to IEEE dbl precision
	subroutine D_VAX2IEEE (dv, n)
	real*8     dv(*)
	integer*4  n
c	include '/usr/lang/SC1.0/include/f77/f77_floatingpoint.h'
c the above dumb include barfs, so we're just going to do this by hand
	integer*4  convert_external, src(4), dst(4), iround, istat
	src(1) = 2  ! convert_external_vax
	src(2) = 2  ! convert_external_float
	src(3) = 8  ! bytes
	dst(1) = 0  ! convert_external_sparc
	dst(2) = 2  ! convert_external_float
	dst(3) = 8  ! bytes
	iround = -1 ! convert_external_common
	istat = convert_external (dv, src, dv, dst, iround, n)
	return
	end


c ***** Major assumption: all VAX double precisions are D-Floating *****
c Use SunOS convert_external routine to convert from IEEE to VAX dbl precision
	subroutine D_IEEE2VAX (dv, n)
	real*8       dv(*)
	integer*4    n
c	include '/usr/lang/SC1.0/include/f77/f77_floatingpoint.h'
c the above dumb include barfs, so we're just going to do this by hand
	integer*4    convert_external, src(4), dst(4), iround, istat
	src(1) = 0  ! convert_external_sparc
	src(2) = 2  ! convert_external_float
	src(3) = 8  ! bytes
	dst(1) = 2  ! convert_external_vax
	dst(2) = 2  ! convert_external_float
	dst(3) = 8  ! bytes
	iround = -1 ! convert_external_common
	istat = convert_external (dv, src, dv, dst, iround, n)
	return
	end


#elif _VMS

c ***** Major assumption: all VAX double precisions are D-Floating *****
c Swap bytes, tweak exponent, then go to VAX D floating point to convert 
c IEEE to VAX double precision
	options /g_floating
	subroutine D_IEEE2VAX (dv, n)
	real*8     dv(*), d1, d2
	integer*4  n, i
	byte       b1(8), b2(8)
	equivalence (d1,b1), (d2,b2)
	external  lib$fixup_flt
	call lib$establish (lib$fixup_flt)
	do i = 1,n
	  d1 = dv(i)
	  b2(1) = b1(2)
	  b2(2) = b1(1)
	  b2(3) = b1(4)
	  b2(4) = b1(3)
	  b2(5) = b1(6)
	  b2(6) = b1(5)
	  b2(7) = b1(8)
	  b2(8) = b1(7)
	  dv(i) = d2*4.d0
	enddo	
	call MTH$CVT_GA_DA (dv, dv, n)
	return
	end


c ***** Major assumption: all VAX double precisions are D-Floating *****
c Go to VAX G floating point, tweak exponent, then swap bytes to convert VAX 
c to IEEE double precision
	options /g_floating
	subroutine D_VAX2IEEE (dv, n)
	real*8       dv(*), d1, d2
	integer*4    n, i
	byte         b1(8), b2(8)
	equivalence (d1,b1), (d2,b2)
	call MTH$CVT_DA_GA (dv, dv, n)
	do i = 1,n
	  d1 = dv(i)/4.d0
	  b2(1) = b1(2)
	  b2(2) = b1(1)
	  b2(3) = b1(4)
	  b2(4) = b1(3)
	  b2(5) = b1(6)
	  b2(6) = b1(5)
	  b2(7) = b1(8)
	  b2(8) = b1(7)
	  dv(i) = d2
	enddo
	return
	end

#endif


c-------------------------------------------------------------------
c
c  EEEI - IEEE-754 Little Endian Floating Point (e.g. IBM-PC):
c
c  Same as IEEE but bytes are in reverse order
c
c	EEEI Byte Order:
c	    +--------------------------+
c	    | b7 b6 b5 b4 b3 b2 b1 b0  |
c	    +--------------------------+
c
c	VAX Byte Order:
c	    +--------------------------+
c	    | b1 b0 b3 b2 b5 b4 b7 b6  |
c	    +--------------------------+
c
c  Hence:
c  To convert EEEI to VAX single precision, SWAP WORDS and MULT BY 4
c                                           ========================
c
c  For double precision, REVERSE WORDS, MULT BY 4 and CONVERT VAX D to G
c                        ===============================================
c
c-------------------------------------------------------------------

c ============================= Single Precision EEEI/VAX Conversions =====

#if _LINX|_OSF

c
c The code for these conversions is located on the C side for
c LINX and OSF.
c

#elif _VMSX

c
c The Alpha has specialized conversion routines.
c

c Swap words and tweak exponent to convert EEEI to VAX floating point
	subroutine F_EEEI2VAX (fv, n)
	include '($cvtdef)'
	real*4     fv(*)
	integer*4  n, i, stat, CVT$CONVERT_FLOAT, opt
	opt = cvt$m_round_to_nearest
	do i = 1,n
	  stat = CVT$CONVERT_FLOAT (fv(i),%val(cvt$k_ieee_s),
     &		fv(i),%val(cvt$k_vax_f), %val(opt) )
	  if (.not.stat) call LIB$SIGNAL (%val(stat))
	enddo	
	return
	end


c Tweak exponent and swap words to convert EEEI to VAX floating point
	subroutine F_VAX2EEEI (fv, n)
	include '($cvtdef)'
	real*4     fv(*)
	integer*4  n, i, stat, CVT$CONVERT_FLOAT, opt
	opt = cvt$m_round_to_nearest
	do i = 1,n
	  stat = CVT$CONVERT_FLOAT (fv(i),%val(cvt$k_vax_f),
     &		fv(i),%val(cvt$k_ieee_s), %val(opt) )
	  if (.not.stat) call LIB$SIGNAL (%val(stat))
	enddo	
	return
	end

#elif _VMS

c Swap words and tweak exponent to convert EEEI to VAX floating point
	subroutine F_EEEI2VAX (fv, n)
	real*4     fv(*), f1,f2
	integer*4  n, i
	integer*2  i1(2), i2(2)
	equivalence (f1,i1), (f2,i2)
	external  lib$fixup_flt
	call lib$establish (lib$fixup_flt)
	do i = 1,n
	  f1 = fv(i)
	  i2(1) = i1(2)
	  i2(2) = i1(1)
	  fv(i) = f2*4
	enddo	
	return
	end


c Tweak exponent and swap words to convert EEEI to VAX floating point
	subroutine F_VAX2EEEI (fv, n)
	real*4     fv(*), f1,f2
	integer*4  n, i
	integer*2  i1(2), i2(2)
	equivalence (f1,i1), (f2,i2)
	do i = 1,n
	  f1 = fv(i)/4
	  i2(1) = i1(2)
	  i2(2) = i1(1)
	  fv(i) = f2
	enddo	
	return
	end

#endif


c ============================= Double Precision EEEI/VAX Conversions =====

#if _LINX|_OSF

c
c This code is located on the C side for LINX and OSF
c

#elif _VMSX

c
c The Alpha has specialized routines for these conversions
c

c ***** Major assumption: all VAX double precisions are D-Floating *****
c Reverse words, tweak exponent, then go to VAX D floating point to convert
c EEEI to VAX double precision.  
	subroutine D_EEEI2VAX (dv, n)
	include '($cvtdef)'
	real*8     dv(*)
	integer*4  n, i, stat, CVT$CONVERT_FLOAT, opt
	opt = cvt$m_round_to_nearest
	do i = 1,n
	  stat = CVT$CONVERT_FLOAT (dv(i),%val(cvt$k_ieee_t),
     &		dv(i),%val(cvt$k_vax_d), %val(opt) )
	  if (.not.stat) call LIB$SIGNAL (%val(stat))
	enddo	
	return
	end


c ***** Major assumption: all VAX double precisions are D-Floating *****
c Go to VAX D floating point, tweak exponent, then reverse words to convert
c VAX to EEEI double precision.  
	subroutine D_VAX2EEEI (dv, n)
	include '($cvtdef)'
	real*8     dv(*) 
	integer*4  n, i, stat, CVT$CONVERT_FLOAT, opt
	opt = cvt$m_round_to_nearest
	do i = 1,n
	  stat = CVT$CONVERT_FLOAT (dv(i),%val(cvt$k_vax_d),
     &		dv(i),%val(cvt$k_ieee_t), %val(opt) )
	  if (.not.stat) call LIB$SIGNAL (%val(stat))
	enddo	
	return
	end

#elif _VMS

c ***** Major assumption: all VAX double precisions are D-Floating *****
c Reverse words, tweak exponent, then go to VAX D floating point to convert
c EEEI to VAX double precision.  
	options /g_floating
	subroutine D_EEEI2VAX (dv, n)
	real*8     dv(*), d1, d2
	integer*4  n, i
	integer*2  i1(4), i2(4)
	equivalence (d1,i1), (d2,i2)
	external  lib$fixup_flt
	call lib$establish (lib$fixup_flt)
	do i = 1,n
	  d1 = dv(i)
	  i2(1) = i1(4)
	  i2(2) = i1(3)
	  i2(3) = i1(2)
	  i2(4) = i1(1)
	  dv(i) = d2*4.d0
	enddo	
	call MTH$CVT_GA_DA (dv, dv, n)
	return
	end


c ***** Major assumption: all VAX double precisions are D-Floating *****
c Go to VAX D floating point, tweak exponent, then reverse words to convert
c VAX to EEEI double precision.  
	options /g_floating
	subroutine D_VAX2EEEI (dv, n)
	real*8     dv(*), d1, d2
	integer*4  n, i
	integer*2  i1(4), i2(4)
	equivalence (d1,i1), (d2,i2)
	call MTH$CVT_DA_GA (dv, dv, n)
	do i = 1,n
	  d1 = dv(i)/4.d0
	  i2(1) = i1(4)
	  i2(2) = i1(3)
	  i2(3) = i1(2)
	  i2(4) = i1(1)
	  dv(i) = d2
	enddo	
	return
	end

#endif

c ======================================================= CRAY Conversions

c---------------------------------------------------------------------
c
c  CRAY - Cray Big-Endian Floating Point
c
c	bit: 63                       0
c	    +---+-----------+-----------+
c	    | s |  e14..e0  |  f47..f0  | 	<-- Single Precision
c	    +---+-----------+-----------+
c	      1    15 bits     48 bits
c
c	Value = (-1)**s x 2**(e-16384) x .f  [** no implicit 1 **]
c
ccc	Range = min: x.xx*10**-xxx  (s=0/1, e=1, f=0)
ccc		max: x.xx*10**+xxx  (s=0/1, e=32767, f=all ones)
c
c	bit: 127                      64
c	    +---+-----------+-----------+
c	    | s |  e14..e0  | f95..f48  | 	<-- Double Precision
c	    +---+-----------+-----------+
c	      1    15 bits     48 bits
c	bit: 63                        0
c	    +---+-----------+-----------+
c	    | xxxxxxxxxxxx  |  f47..f0  |
c	    +---+-----------+-----------+
c	    16 bits ignored     48 bits
c
c
c	But when single/double precision data is  P A C K E D  in Cray Midas:
c	              			          ===========
c	bit: 31                       0
c	    +---+----------+-----------+
c	    | s |  e7..e0  |  f22..f0  | 	<-- Single Precision Packed
c	    +---+----------+-----------+
c	      1    8 bits     23 bits
c
c	Value = (-1)**s x 2**(e-128) x .f  [** no implicit 1 **]
c
ccc	Range = min: x.xx*10**-xx  (s=0/1, e=1, f=0)
ccc		max: x.xx*10**+xx  (s=0/1, e=255, f=all ones)
c
c
c	bit: 63                       0
c	    +---+-----------+-----------+
c	    | s |  e14..e0  |  f47..f0  | 	<-- Double Precision Packed
c	    +---+-----------+-----------+
c	      1    15 bits     48 bits
c
c	Value = (-1)**s x 2**(e-16384) x .f
c
ccc	Range = min: x.xx*10**-xxx  (s=0/1, e=1, f=0)
ccc		max: x.xx*10**+xxx  (s=0/1, e=32767, f=all ones)
c
c
c	Big-Endian Byte Order:
c	    +--------------------------+
c	    | b0 b1 b2 b3 b4 b5 b6 b7  |
c	    +--------------------------+
c
c
c  Note that real*4 data can be treated as packed real*8 data.  Since the 
c  header is the only place that doesn't have packed data, this artifice 
c  (fake real*8 declarations) will take care of header floating point data.
c
c  Conversion of packed data requires shifting the extra bit out of the
c  mantissa, and for double precision, reducing the exponent--also 
c  accounting for the factor of 4 as we saw in the VAX conversions.
c
c    ** These conversions will NOT handle unpacked real*8 data that **
c    **         might in the future be placed in the header         **
c
c---------------------------------------------------------------------


c
c *** Double precision to and from CRAY ***
c

#if _SUN|_SOL|_IRIX

c ***** Major assumption: all Cray data normalized (exponent=0 => data=0) *****
c ----- Convert PACKED Cray double precision to IEEE -----
	subroutine D_CRAY2IEEE (dv, ct)
	real*8       dv(*)
	integer*4    ct
c
	real*8       da, db
	integer*4    la(2), lb(2), lexp
	equivalence (la,da), (lb,db)

	do i = 1, ct
	  da = dv(i)
c Evaluate and reduce exponent
	  lexp  = ISHFT (IAND(la(1), '7fff0000'x), -16)
	  if (lexp .ne. 0) then
	    lexp = lexp - 16384 + 1022	! 1022 accounts for factor-of-4
c Handle overflow / underflow
	    if (lexp .gt. 2046) then
	      lb(2) = -1
	      lb(1) = '7fefffff'x
	    elseif (lexp .lt. 1) then
	      db = 0
	    else
c Shift mantissa, OR in exponent
	      lb(2) = ISHFT (la(2),5)
	      lb(1) = ISHFT (IAND (la(1),'7fff'x),5) + ISHFT(la(2),-27)
	      lb(1) = IOR (lb(1), ISHFT(lexp,20))
	    endif
c Grab sign
	    dv(i) = db
	    if (la(1) .lt. 0) dv(i) = -db
	  endif
c (If exponent is zero, all else is also zero and requires no shuffling)
	enddo
	return
	end



c ----- Convert IEEE double precision to PACKED Cray -----
	subroutine D_IEEE2CRAY (dv, ct)
	real*8       dv(*)
	integer*4    ct
c
	real*8       da, db
	integer*4    la(2), lb(2), lexp
	equivalence (la,da), (lb,db)

	do i = 1, ct
	  da = dv(i)
c Evaluate and expand exponent
	  lexp  = ISHFT (IAND(la(1), '7ff00000'x), -20)
	  if (lexp .ne. 0) then
	    lexp = lexp - 1022 + 16384  ! 1022 accounts for factor-of-4
c Shift mantissa, set explicit 1, OR in exponent
	    lb(2) = IOR (ISHFT(la(2),-5), ISHFT(IAND(la(1),'1f'x),27) )
	    lb(1) = ISHFT (IAND (la(1),'fffff'x),-5) + '8000'x
	    lb(1) = IOR (lb(1), ISHFT(lexp,16))
c Grab sign
	    dv(i) = db
	    if (la(1) .lt. 0) dv(i) = -db
	  endif
c (If exponent is zero, all else is also zero and requires no shuffling)
	enddo
	return
	end

#elif _CNVX

c
c This code is located on the C side for CNVX
c

#elif _VMSX

c ***** Major assumption: all Cray data normalized (exponent=0 => data=0) *****
c ----- Convert PACKED Cray double precision to VAX -----
	subroutine D_CRAY2VAX (b, ct)
	byte         b(*)
	integer*4    ct
c (Treat input as byte array, so no overflow issues arise)
c
	integer*2    ib(2), lexp
	byte         bb(4)
	equivalence (ib,bb)

	do i = 1, ct
	  j = 8*i
c Get exponent and MS mantissa bytes
	  ib(1) = b(j-5)	!MS mantissa
	  bb(3) = b(j-6)	!exponent; these two bytes are ib(2)
	  bb(4) = b(j-7)
c Evaluate and reduce exponent
	  lexp  = IAND(ib(2), '7fff'x)
	  if (lexp .ne. 0) then
	    lexp = lexp - 16384 + 128
c Handle overflow / underflow
	    if (lexp .gt. 255) then
	      b(j) = -1
	      b(j-1) = -1
	      b(j-2) = -1
	      b(j-3) = -1
	      b(j-4) = -1
	      b(j-5) = -1
	      b(j-6) = -1
	      b(j-7) = -1
	      if (ib(2) .gt. 0) b(j-6) = 127
	    elseif (lexp .lt. 1) then
	      b(j) = 0
	      b(j-1) = 0
	      b(j-2) = 0
	      b(j-3) = 0
	      b(j-4) = 0
	      b(j-5) = 0
	      b(j-6) = 0
	      b(j-7) = 0
	    else
c Strip explicit 1 off mantissa, OR in exponent, grab sign, stuff back into b
	      ib(1) = IAND (ib(1), 127) + lexp*128
	      if (ib(2) .lt. 0) ib(1) = ib(1) - 32768
	      b(j-7) = bb(1)
	      b(j-6) = bb(2)
c Net effect of mantissa shifts, byte order swap is to leave byte 
c indices 4,6,8 in place and move indices 7->5->3  (try it!)
	      b(j-5) = b(j-3)
	      b(j-3) = b(j-1)
	      b(j-1) = 0
	    endif
	  endif
c (If exponent is zero, all else is also zero and requires no shuffling)
	enddo
	return
	end



c ----- Convert VAX double precision to PACKED Cray -----
	subroutine D_VAX2CRAY (b, ct)
	byte         b(*)
	integer*4    ct
c (Treat input as byte array, so no overflow issues arise)
c
	integer*2    ib(2), lexp, lmant
	byte         bb(4)
	equivalence (ib,bb)

	do i = 1, ct
	  j = 8*i
c Grab MS mantissa 
	  lmant = b(j-7)
c Evaluate and expand exponent
	  bb(1) = b(j-7)
	  bb(2) = b(j-6)
	  lexp  = IAND(ib(1), '7f80'x) / 128
	  if (lexp .ne. 0) then
	    ib(1) = lexp - 128 + 16384
c Set sign and stuff exponent back 
	    if (b(j-6) .lt. 0) ib(1) = ib(1) - 32768
	    b(j-7) = bb(2)
	    b(j-6) = bb(1)
c Net effect of mantissa shifts, byte order swap is to leave byte 
c indices 4,6,8 in place and move indices 5->7 (try it!)
	    b(j-1) = b(j-3)
	    b(j-3) = b(j-5)
c Now set explicit 1 in MS mantissa and stuff it back too
	    b(j-5) = IAND(lmant, '7f'x) - 128
	  endif
c (If exponent is zero, all else is also zero and requires no shuffling)
	enddo
	return
	end


#elif _VMS

c ***** Major assumption: all Cray data normalized (exponent=0 => data=0) *****
c ----- Convert PACKED Cray double precision to VAX -----
	subroutine D_CRAY2VAX (b, ct)
	byte         b(*)
	integer*4    ct
c (Treat input as byte array, so no overflow issues arise)
c
	integer*2    ib(2), lexp
	byte         bb(4)
	equivalence (ib,bb)
	external  lib$fixup_flt
	call lib$establish (lib$fixup_flt)

	do i = 1, ct
	  j = 8*i
c Get exponent and MS mantissa bytes
	  ib(1) = b(j-5)	!MS mantissa
	  bb(3) = b(j-6)	!exponent; these two bytes are ib(2)
	  bb(4) = b(j-7)
c Evaluate and reduce exponent
	  lexp  = IAND(ib(2), '7fff'x)
	  if (lexp .ne. 0) then
	    lexp = lexp - 16384 + 128
c Handle overflow / underflow
	    if (lexp .gt. 255) then
	      b(j) = -1
	      b(j-1) = -1
	      b(j-2) = -1
	      b(j-3) = -1
	      b(j-4) = -1
	      b(j-5) = -1
	      b(j-6) = -1
	      b(j-7) = -1
	      if (ib(2) .gt. 0) b(j-6) = 127
	    elseif (lexp .lt. 1) then
	      b(j) = 0
	      b(j-1) = 0
	      b(j-2) = 0
	      b(j-3) = 0
	      b(j-4) = 0
	      b(j-5) = 0
	      b(j-6) = 0
	      b(j-7) = 0
	    else
c Strip explicit 1 off mantissa, OR in exponent, grab sign, stuff back into b
	      ib(1) = IAND (ib(1), 127) + lexp*128
	      if (ib(2) .lt. 0) ib(1) = ib(1) - 32768
	      b(j-7) = bb(1)
	      b(j-6) = bb(2)
c Net effect of mantissa shifts, byte order swap is to leave byte 
c indices 4,6,8 in place and move indices 7->5->3  (try it!)
	      b(j-5) = b(j-3)
	      b(j-3) = b(j-1)
	      b(j-1) = 0
	    endif
	  endif
c (If exponent is zero, all else is also zero and requires no shuffling)
	enddo
	return
	end


c ----- Convert VAX double precision to PACKED Cray -----
	subroutine D_VAX2CRAY (b, ct)
	byte         b(*)
	integer*4    ct
c (Treat input as byte array, so no overflow issues arise)
c
	integer*2    ib(2), lexp, lmant
	byte         bb(4)
	equivalence (ib,bb)

	do i = 1, ct
	  j = 8*i
c Grab MS mantissa 
	  lmant = b(j-7)
c Evaluate and expand exponent
	  bb(1) = b(j-7)
	  bb(2) = b(j-6)
	  lexp  = IAND(ib(1), '7f80'x) / 128
	  if (lexp .ne. 0) then
	    ib(1) = lexp - 128 + 16384
c Set sign and stuff exponent back 
	    if (b(j-6) .lt. 0) ib(1) = ib(1) - 32768
	    b(j-7) = bb(2)
	    b(j-6) = bb(1)
c Net effect of mantissa shifts, byte order swap is to leave byte 
c indices 4,6,8 in place and move indices 5->7 (try it!)
	    b(j-1) = b(j-3)
	    b(j-3) = b(j-5)
c Now set explicit 1 in MS mantissa and stuff it back too
	    b(j-5) = IAND(lmant, '7f'x) - 128
	  endif
c (If exponent is zero, all else is also zero and requires no shuffling)
	enddo
	return
	end

#endif


c
c *** Single precision to and from CRAY ***
c


#if _SUN|_SOL|_IRIX

c ----- Convert PACKED Cray single precision to IEEE -----
	subroutine F_CRAY2IEEE (fv, ct)
	real*4       fv(*)
	integer*4    ct
c
	real*4       f
	integer*4    l, lexp, lmant, i
	equivalence (l,f)

	do i = 1, ct
	  f     = fv(i)
c Shift mantissa and mask back in
	  lexp  = IAND (l, 'ff800000'x)
	  lmant = IAND (ISHFT(l,1), '7fffff'x)
	  l     = IOR (lexp, lmant)
	  fv(i) = f/4
	enddo
	return
	end



c ----- Convert IEEE single precision to PACKED Cray -----
	subroutine F_IEEE2CRAY (fv, ct)
	real*4       fv(*)
	integer*4    ct
c
	real*4       f
	integer*4    l, lexp, lmant, i
	equivalence (l,f)

	do i = 1, ct
	  f     = fv(i)*4
c Shift mantissa, set explicit 1, and mask back in
	  lexp  = IAND (l, 'ff800000'x)
	  lmant = IAND (ISHFT(l,-1), '3fffff'x) + '400000'x
	  l     = IOR (lexp, lmant)
	  fv(i) = f
	enddo
	return
	end

#elif _CNVX

c
c This code is located on the C side for CNVX
c

#elif _VMSX

c ----- Convert PACKED Cray single precision to VAX -----
	subroutine F_CRAY2VAX (b, ct)
	byte         b(*)
	integer*4    ct
c (Treat input as byte array, so no overflow issues arise)
c
	integer*4    lb, lexp, lmant, i,j
	byte         bb(4)
	equivalence (lb,bb)

	do i = 1, ct
c Reverse byte order, so that Cray bits are ordered like a VAX integer
	  j = 4*i
	  bb(1) = b(j)
	  bb(2) = b(j-1)
	  bb(3) = b(j-2)
	  bb(4) = b(j-3)
c Check for zero mantissa
	  if (IAND(lb,'7fffff'x).eq.0) then
	    lb = 0
	  else
c Shift mantissa and mask back in
	    lexp  = IAND (lb, 'ff800000'x)
	    lmant = IAND (ISHFT(lb,1), '7fffff'x)
	    lb    = IOR (lexp, lmant)
	  endif
c Swap words to get bits back into floating point order
	  b(j)   = bb(2)
	  b(j-1) = bb(1)
	  b(j-2) = bb(4)
	  b(j-3) = bb(3)
	enddo
	return
	end




c ----- Convert VAX single precision to PACKED Cray -----
	subroutine F_VAX2CRAY (b, ct)
	byte         b(*)
	integer*4    ct
c (Treat input as byte array, so no overflow issues arise)
c
	integer*4    lb, lexp, lmant, i,j
	byte         bb(4)
	equivalence (lb,bb)

	do i = 1, ct
c Swap words so that bits are ordered like a VAX integer
	  j = 4*i
	  bb(1) = b(j-1)
	  bb(2) = b(j)
	  bb(3) = b(j-3)
	  bb(4) = b(j-2)
c Shift mantissa, set explicit 1, and mask back in
	  lexp  = IAND (lb, 'ff800000'x)
	  lmant = IAND (ISHFT(lb,-1), '3fffff'x) + '400000'x
	  lb    = IOR (lexp, lmant)
c Reverse byte order to give Cray floating point
	  b(j)   = bb(1)
	  b(j-1) = bb(2)
	  b(j-2) = bb(3)
	  b(j-3) = bb(4)
	enddo
	return
	end


#elif _VMS

c ----- Convert PACKED Cray single precision to VAX -----
	subroutine F_CRAY2VAX (b, ct)
	byte         b(*)
	integer*4    ct
c (Treat input as byte array, so no overflow issues arise)
c
	integer*4    lb, lexp, lmant, i,j
	byte         bb(4)
	equivalence (lb,bb)
	external  lib$fixup_flt
	call lib$establish (lib$fixup_flt)

	do i = 1, ct
c Reverse byte order, so that Cray bits are ordered like a VAX integer
	  j = 4*i
	  bb(1) = b(j)
	  bb(2) = b(j-1)
	  bb(3) = b(j-2)
	  bb(4) = b(j-3)
c Check for zero mantissa
	  if (IAND(lb,'7fffff'x).eq.0) then
	    lb = 0
	  else
c Shift mantissa and mask back in
	    lexp  = IAND (lb, 'ff800000'x)
	    lmant = IAND (ISHFT(lb,1), '7fffff'x)
	    lb    = IOR (lexp, lmant)
	  endif
c Swap words to get bits back into floating point order
	  b(j)   = bb(2)
	  b(j-1) = bb(1)
	  b(j-2) = bb(4)
	  b(j-3) = bb(3)
	enddo
	return
	end



c ----- Convert VAX single precision to PACKED Cray -----
	subroutine F_VAX2CRAY (b, ct)
	byte         b(*)
	integer*4    ct
c (Treat input as byte array, so no overflow issues arise)
c
	integer*4    lb, lexp, lmant, i,j
	byte         bb(4)
	equivalence (lb,bb)

	do i = 1, ct
c Swap words so that bits are ordered like a VAX integer
	  j = 4*i
	  bb(1) = b(j-1)
	  bb(2) = b(j)
	  bb(3) = b(j-3)
	  bb(4) = b(j-2)
c Shift mantissa, set explicit 1, and mask back in
	  lexp  = IAND (lb, 'ff800000'x)
	  lmant = IAND (ISHFT(lb,-1), '3fffff'x) + '400000'x
	  lb    = IOR (lexp, lmant)
c Reverse byte order to give Cray floating point
	  b(j)   = bb(1)
	  b(j-1) = bb(2)
	  b(j-2) = bb(3)
	  b(j-3) = bb(4)
	enddo
	return
	end

#endif
