eesupp/src/mds_byteswapr8.F

C $Header: /u/gcmpack/MITgcm/eesupp/src/mds_byteswapr8.F,v 1.1 2005/08/23 13:21:08 jmc Exp $
C $Name:  $

#include "CPP_EEOPTIONS.h"

      subroutine MDS_BYTESWAPR8( n, arr )
C IN:
C   n           integer - Number of 8-byte words in arr
C IN/OUT:
C   arr         real*8  - Array declared as real*4(n)
C
C Created: 05/05/99 adcroft@mit.edu (This is an unfortunate hack!!)

      implicit none

#ifdef FAST_BYTESWAP

C Arguments
      integer n
      integer(kind=8) arr(n),i64,i1

C Local
      integer i

      i64(i1) = ishft(i1 .and. z'ff00000000000000',-56).or.
     &          ishft(i1 .and. z'00ff000000000000',-40).or.
     &          ishft(i1 .and. z'0000ff0000000000',-24).or.
     &          ishft(i1 .and. z'000000ff00000000', -8).or.
     &          ishft(i1 .and. z'00000000ff000000',  8).or.
     &          ishft(i1 .and. z'0000000000ff0000', 24).or.
     &          ishft(i1 .and. z'000000000000ff00', 40).or.
     &          ishft(i1 .and. z'00000000000000ff', 56)
      do i=1,n
      arr(i) = i64(arr(i))
      enddo

#else /* FAST_BYTESWAP */

C Arguments
      integer n
      character*(*) arr

C Local
      integer i
      character*(1) cc

      do i=1,8*n,8
       cc=arr(i:i)
       arr(i:i)=arr(i+7:i+7)
       arr(i+7:i+7)=cc
       cc=arr(i+1:i+1)
       arr(i+1:i+1)=arr(i+6:i+6)
       arr(i+6:i+6)=cc
       cc=arr(i+2:i+2)
       arr(i+2:i+2)=arr(i+5:i+5)
       arr(i+5:i+5)=cc
       cc=arr(i+3:i+3)
       arr(i+3:i+3)=arr(i+4:i+4)
       arr(i+4:i+4)=cc
      enddo

#endif /* FAST_BYTESWAP */

      return
      end
1	dimitri	1.2	C $Header: /u/gcmpack/MITgcm/eesupp/src/mds_byteswapr8.F,v 1.1 2005/08/23 13:21:08 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "CPP_EEOPTIONS.h"
5
6			subroutine MDS_BYTESWAPR8( n, arr )
7			C IN:
8			C n integer - Number of 8-byte words in arr
9			C IN/OUT:
10			C arr real8 - Array declared as real4(n)
11			C
12			C Created: 05/05/99 adcroft@mit.edu (This is an unfortunate hack!!)
13
14			implicit none
15	dimitri	1.2
16			#ifdef FAST_BYTESWAP
17
18			C Arguments
19			integer n
20			integer(kind=8) arr(n),i64,i1
21
22			C Local
23			integer i
24
25			i64(i1) = ishft(i1 .and. z'ff00000000000000',-56).or.
26			& ishft(i1 .and. z'00ff000000000000',-40).or.
27			& ishft(i1 .and. z'0000ff0000000000',-24).or.
28			& ishft(i1 .and. z'000000ff00000000', -8).or.
29			& ishft(i1 .and. z'00000000ff000000', 8).or.
30			& ishft(i1 .and. z'0000000000ff0000', 24).or.
31			& ishft(i1 .and. z'000000000000ff00', 40).or.
32			& ishft(i1 .and. z'00000000000000ff', 56)
33			do i=1,n
34			arr(i) = i64(arr(i))
35			enddo
36
37			#else /* FAST_BYTESWAP */
38
39	jmc	1.1	C Arguments
40			integer n
41			character() arr
42	dimitri	1.2
43	jmc	1.1	C Local
44			integer i
45			character*(1) cc
46	dimitri	1.2
47	jmc	1.1	do i=1,8*n,8
48			cc=arr(i:i)
49			arr(i:i)=arr(i+7:i+7)
50			arr(i+7:i+7)=cc
51			cc=arr(i+1:i+1)
52			arr(i+1:i+1)=arr(i+6:i+6)
53			arr(i+6:i+6)=cc
54			cc=arr(i+2:i+2)
55			arr(i+2:i+2)=arr(i+5:i+5)
56			arr(i+5:i+5)=cc
57			cc=arr(i+3:i+3)
58			arr(i+3:i+3)=arr(i+4:i+4)
59			arr(i+4:i+4)=cc
60			enddo
61	dimitri	1.2
62			#endif /* FAST_BYTESWAP */
63
64	jmc	1.1	return
65			end