Endian_Utility.f90

Go to the documentation of this file.

!--------------------------------------------------------------------------------
!M+
! NAME:
!       Endian_Utility
!
! PURPOSE:
!       Module containing functions to byte-swap intrinsic data types.
!
! CATEGORY:
!       Utility
!
! LANGUAGE:
!       Fortran-95
!
! CALLING SEQUENCE:
!       USE Endian_Utility
!
! MODULES:
!       Type_Kinds:   Module to hold specification kinds for variable
!                     declaration.
!
! CONTAINS:
!       Big_Endian:   Logical function that returns .TRUE. if platform
!                     is big endian.
!
!       Swap_Endian:  Function that byte-swaps input arguments.
!
! INCLUDE FILES:
!       None.
!
! EXTERNALS:
!       None.
!
! COMMON BLOCKS:
!       None.
!
! FILES ACCESSED:
!       None.
!
! SIDE EFFECTS:
!       None.
!
! RESTRICTIONS:
!       None.
!
! CREATION HISTORY:
!         Written by:   Paul van Delst, CIMSS/SSEC, 17-Mar-2000
!                       paul.vandelst@ssec.wisc.edu
!
!  Copyright (C) 2000 Paul van Delst
!
!  This program is free software; you can redistribute it and/or
!  modify it under the terms of the GNU General Public License
!  as published by the Free Software Foundation; either version 2
!  of the License, or (at your option) any later version.
!
!  This program is distributed in the hope that it will be useful,
!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!  GNU General Public License for more details.
!
!  You should have received a copy of the GNU General Public License
!  along with this program; if not, write to the Free Software
!  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
!M-
!--------------------------------------------------------------------------------

MODULE endian_utility


  ! ----------
  ! Module use
  ! ----------
 
  USE type_kinds

 
  ! ---------------------------
  ! Disable all implicit typing
  ! ---------------------------

  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------

  PRIVATE
  PUBLIC :: big_endian
  PUBLIC :: swap_endian

          
  ! ------------------
  ! Overload interface
  ! ------------------

  INTERFACE swap_endian
    MODULE PROCEDURE swap_short_integer
    MODULE PROCEDURE swap_long_integer
    MODULE PROCEDURE swap_llong_integer
    MODULE PROCEDURE swap_single_float
    MODULE PROCEDURE swap_double_float
    MODULE PROCEDURE swap_single_complex
    MODULE PROCEDURE swap_double_complex
  END INTERFACE swap_endian


CONTAINS


!################################################################################
!################################################################################
!##                                                                            ##
!##                         ## PUBLIC MODULE ROUTINES ##                       ##
!##                                                                            ##
!################################################################################
!################################################################################

!--------------------------------------------------------------------------------
!S+
! NAME:
!       Big_Endian
!
! PURPOSE:
!       Function to determine if current platform is big-endian.
!
! CATEGORY:
!       Utility
!
! LANGUAGE:
!       Fortran-95
!
! CALLING SEQUENCE:
!       Result = Big_Endian()
!
! INPUT ARGUMENTS:
!       None.
!
! OPTIONAL INPUT ARGUMENTS:
!       None.
!
! OUTPUT ARGUMENTS:
!       None.
!
! OPTIONAL OUTPUT ARGUMENTS:
!       None.
!
! FUNCTION RESULT:
!       Result:    The return value is a logical value indicating whether
!                  the current platform is big-endian or not
!                  .TRUE.  - it is a big-endian platform.
!                  .FALSE. - it is NOT a big-endian platform.
!                  UNITS:      N/A
!                  TYPE:       LOGICAL
!                  DIMENSION:  Scalar
!
! CALLS:
!       None.
!
! CONTAINS:
!       None.
!
! SIDE EFFECTS:
!       None
!
! RESTRICTIONS:
!       None
!
! PROCEDURE:
!       Uses the Fortran90/95 intrinsics TRANSFER and IACHAR to test
!       if a 2-byte integer (value 1) retains that value when
!       transferred to a single-byte character representation. If
!       it does, the platform is little-endian. If not, it is big-
!       endian. This method was suggested by Clive Page, University
!       of Leicester, UK.
!
! EXAMPLE:
!       USE Endian_Utility
!         .....
!       WRITE( *, '( 5x, "Platform is " )', ADVANCE = 'NO' )
!       IF ( Big_Endian() ) THEN
!         WRITE( *, '( "big-endian." )' )
!       ELSE
!         WRITE( *, '( "litle-endian." )' )
!       END IF
!
!S-
!--------------------------------------------------------------------------------

  FUNCTION big_endian()


    ! ---------------
    ! Local variables
    ! ---------------

    INTEGER( Short ) :: source = 1_short


    ! ------------
    ! The function
    ! ------------

    LOGICAL :: big_endian


    ! ----------
    ! Intrinsics
    ! ----------

    INTRINSIC transfer, ichar


    ! ----------------------------------
    ! Initialise result to little-endian
    ! ----------------------------------

    big_endian = .false.


    ! ------------------------------------------------------------
    ! Test for "endian-ness".
    !
    ! TRANSFER( source, 'a' ) returns a result with the physical
    !   representation of the number 1, i.e. an integer, but
    !   interpreted as a character (the type of 'a' - a character,
    !   not the value, is what is important).
    !
    ! IACHAR returns the position of a character in the ASCII
    !   collating sequence associated with the kind type parameter
    !   of the character.
    ! ------------------------------------------------------------

    IF ( iachar( transfer( source, 'a' ) ) == 0 ) big_endian = .true.

  END FUNCTION big_endian





!--------------------------------------------------------------------------------
!S+
! NAME:
!       Swap_Endian
!
! PURPOSE:
!       Function to byte-swap input data.
!
! CATEGORY:
!       Utility
!
! LANGUAGE:
!       Fortran-95
!
! CALLING SEQUENCE:
!       Result = Swap_Endian( Input )
!
! INPUT ARGUMENTS:
!       Input:       Data object to be byte swapped.
!                    UNITS:      N/A
!                    TYPE:       Any of the following:
!                                  INTEGER( Short )
!                                  INTEGER( Long  )  [ == default integer]
!                                  INTEGER( LLong )
!                                  REAL( Single )   [ == default real]
!                                  REAL( Double )
!                                  COMPLEX( Single )
!                                  COMPLEX( Double )
!                    DIMENSION:  Scalar, or any allowed rank array.
!                    ATTRIBUTES: INTENT( IN )
!
! OPTIONAL INPUT ARGUMENTS:
!       None.
!
! OUTPUT ARGUMENTS:
!       None.
!
! OPTIONAL OUTPUT ARGUMENTS:
!       None.
!
! FUNCTION RESULT:
!       Result:      The return value is the byte swapped value
!                    UNITS:      N/A
!                    TYPE:       Same as Input
!                    DIMENSION:  Same as Input
!
! CALLS:
!       None.
!
! CONTAINS:
!       None.
!
! SIDE EFFECTS:
!       None
!
! RESTRICTIONS:
!       None.
!
! PROCEDURE:
!       The TRANSFER intrinsic is used to rearrange the bytes by accessing
!       the data with a subscript triplet having a negative stride.
!
!       This method can be slow, not because of the TRANSFER function itself,
!       but the negative stride of the array access. It depends on the 
!       quality of implementation.
!
!       The byte-swap for the complex data types are only slightly
!       different in that each half of the total number representation
!       in bytes is swapped rather than the whole thing (i.e. real and
!       imaginary are swapped separately).
!
!S-
!--------------------------------------------------------------------------------

  ELEMENTAL FUNCTION swap_short_integer ( Input ) RESULT ( Output )


    ! -------------------
    ! Argument and result
    ! -------------------

    INTEGER( Short ), INTENT( IN ) :: input
    INTEGER( Short )               :: output


    ! ----------------
    ! Local parameters
    ! ----------------

    INTEGER, PARAMETER :: n = n_bytes_short


    ! ---------------
    ! Local variables
    ! ---------------

    INTEGER( Byte ), DIMENSION( N ) :: byte_equivalent


    ! ------------------------------------------------
    ! Byte swap the data. The extra step in the middle
    ! is necessary for those compilers that can't
    ! handle a negative strided input to TRANSFER
    ! ------------------------------------------------

    byte_equivalent = transfer( input, byte_equivalent )
    byte_equivalent = byte_equivalent( n:1:-1 )
    output          = transfer( byte_equivalent, output )

  END FUNCTION swap_short_integer


  ELEMENTAL FUNCTION swap_long_integer ( Input ) RESULT ( Output )


    ! -------------------
    ! Argument and result
    ! -------------------

    INTEGER( Long ), INTENT( IN ) :: input
    INTEGER( Long )               :: output


    ! ----------------
    ! Local parameters
    ! ----------------

    INTEGER, PARAMETER :: n = n_bytes_long


    ! ---------------
    ! Local variables
    ! ---------------

    INTEGER( Byte ), DIMENSION( N ) :: byte_equivalent


    ! ------------------------------------------------
    ! Byte swap the data. The extra step in the middle
    ! is necessary for those compilers that can't
    ! handle a negative strided input to TRANSFER
    ! ------------------------------------------------

    byte_equivalent = transfer( input, byte_equivalent )
    byte_equivalent = byte_equivalent( n:1:-1 )
    output          = transfer( byte_equivalent, output )

  END FUNCTION swap_long_integer


  ELEMENTAL FUNCTION swap_llong_integer ( Input ) RESULT ( Output )


    ! -------------------
    ! Argument and result
    ! -------------------

    INTEGER( LLong ), INTENT( IN ) :: input
    INTEGER( LLong )               :: output


    ! ----------------
    ! Local parameters
    ! ----------------

    INTEGER, PARAMETER :: n = n_bytes_llong


    ! ---------------
    ! Local variables
    ! ---------------

    INTEGER( Byte ), DIMENSION( N ) :: byte_equivalent


    ! ------------------------------------------------
    ! Byte swap the data. The extra step in the middle
    ! is necessary for those compilers that can't
    ! handle a negative strided input to TRANSFER
    ! ------------------------------------------------

    byte_equivalent = transfer( input, byte_equivalent )
    byte_equivalent = byte_equivalent( n:1:-1 )
    output          = transfer( byte_equivalent, output )

  END FUNCTION swap_llong_integer


  ELEMENTAL FUNCTION swap_single_float ( Input ) RESULT ( Output )


    ! -------------------
    ! Argument and result
    ! -------------------

    REAL( Single ), INTENT( IN ) :: input
    REAL( Single )               :: output


    ! ----------------
    ! Local parameters
    ! ----------------

    INTEGER, PARAMETER :: n = n_bytes_single


    ! ---------------
    ! Local variables
    ! ---------------

    INTEGER( Byte ), DIMENSION( N ) :: byte_equivalent


    ! ------------------------------------------------
    ! Byte swap the data. The extra step in the middle
    ! is necessary for those compilers that can't
    ! handle a negative strided input to TRANSFER
    ! ------------------------------------------------

    byte_equivalent = transfer( input, byte_equivalent )
    byte_equivalent = byte_equivalent( n:1:-1 )
    output          = transfer( byte_equivalent, output )

  END FUNCTION swap_single_float


  ELEMENTAL FUNCTION swap_double_float ( Input ) RESULT ( Output )


    ! -------------------
    ! Argument and result
    ! -------------------

    REAL( Double ), INTENT( IN ) :: input
    REAL( Double )               :: output


    ! ----------------
    ! Local parameters
    ! ----------------

    INTEGER, PARAMETER :: n = n_bytes_double


    ! ---------------
    ! Local variables
    ! ---------------

    INTEGER( Byte ), DIMENSION( N ) :: byte_equivalent


    ! ------------------------------------------------
    ! Byte swap the data. The extra step in the middle
    ! is necessary for those compilers that can't
    ! handle a negative strided input to TRANSFER
    ! ------------------------------------------------

    byte_equivalent = transfer( input, byte_equivalent )
    byte_equivalent = byte_equivalent( n:1:-1 )
    output          = transfer( byte_equivalent, output )

  END FUNCTION swap_double_float


  ELEMENTAL FUNCTION swap_single_complex ( Input ) RESULT ( Output )


    ! -------------------
    ! Argument and result
    ! -------------------

    COMPLEX( Single ), INTENT( IN ) :: input
    COMPLEX( Single )               :: output


    ! ------------------
    ! Byte-swap the data
    ! ------------------

    output = cmplx( swap_endian( REAL( Input,          Single ) ), &   ! Real
                    swap_endian( REAL( AIMAG( Input ), Single ) ), &   ! Imaginary
                    single )

  END FUNCTION swap_single_complex


  ELEMENTAL FUNCTION swap_double_complex ( Input ) RESULT ( Output )


    ! -------------------
    ! Argument and result
    ! -------------------

    COMPLEX( Double ), INTENT( IN ) :: input
    COMPLEX( Double )               :: output


    ! ------------------
    ! Byte-swap the data
    ! ------------------

    output = cmplx( swap_endian( REAL( Input,          Double ) ), &   ! Real
                    swap_endian( REAL( AIMAG( Input ), Double ) ), &   ! Imaginary
                    double )


  END FUNCTION swap_double_complex

END MODULE endian_utility



!-------------------------------------------------------------------------------
!                          -- MODIFICATION HISTORY --
!-------------------------------------------------------------------------------
!
! $Id: Endian_Utility.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $
!
! $Date: 2004/12/01 19:35:15 $
!
! $Revision: 60152 $
!
! $State: Exp $
!
! $Name:  $
!
! $Log: Endian_Utility.f90,v $
! Revision 2.3  2004/12/01 19:35:15  paulv
! - Documentation errors corrected.
!
! Revision 2.2  2004/08/17 14:36:24  paulv
! - Changed the comment header for the actual byte-swapping code.
! - Note the log message for the last update is incorrect - the negative
!   stride must be removed from the input argument to TRANSFER to prevent
!   run-time crashes when versions of the xlf 8.1 compiler are used.
!
! Revision 2.1  2004/08/16 16:04:22  paulv
! - Due to an IBM xlf compiler bug I changed
!     Output = TRANSFER( Byte_Equivalent( N:1:-1 ), Output )
!   to
!     Byte_Equivalent = Byte_Equivalent( N:1:-1 )
!     Output = TRANSFER( (Byte_Equivalent(N:1:-1), Output )
!   The negative stride triplet used in the input to TRANSFER was causing
!   a Trace/BPT fault on the IBM (crashed the debugger too!).
!
! Revision 2.0  2004/08/12 22:23:16  paulv
! - New version.
! - Swap_Endian functions are now ELEMENTAL and accept any rank array input.
!
! Revision 1.3  2004/07/01 17:44:25  paulv
! - Repository resync. Last modified Nov 8, 2001.
!
! Revision 1.2  2000/06/02 16:26:12  paulv
! Removed 8-byte integer swapping routines. This data type is not generally
! supported so the functionality was removed.
!
! Revision 1.1  2000/04/03 14:48:43  paulv
! Initial checked in version
!
!