!-------------------------------------------------------------------------------- !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 99117 2017-11-27 18:37:14Z tong.zhu@noaa.gov $ ! ! $Date: 2004/12/01 19:35:15 $ ! ! $Revision: 99117 $ ! ! $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 ! !