C-----------------------------------------------------------------------
!
! revision history:
!
! Aug, 2012 Jun Wang bafrio for big and little endian files
!
! note:
! This version of bafrio.f is revised to have byteswap in FORTRAN
! data file control words. It is designed to be run on
! on WCOSS(little endian machine) and to generate big endian files.
! It does byteswap on fortran record control words(4 byte integer
! before and after data field), not on data field itself. Users need
! to byteswap their data after(for reading)/before(for writing)
! calling subroutines this file. This is considered to be the best
! way to keep subroutine inerfaces intact for backward compatible.
!
C-----------------------------------------------------------------------
SUBROUTINE BAFRINDEX(LU,IB,LX,IX)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: BAFRINDEX BYTE-ADDRESSABLE FORTRAN RECORD INDEX
C PRGMMR: IREDELL ORG: W/NMC23 DATE: 1999-01-21
C
C ABSTRACT: THIS SUBPROGRAM IS CALLING BAFRINDEXL TO EITHER READ AN
C UNFORMATTED FORTRAN RECORD
C AND RETURN ITS LENGTH AND START BYTE OF THE NEXT FORTRAN RECORD;
C OR GIVEN THE RECORD LENGTH, WITHOUT I/O IT DETERMINES THE START BYTE
C OF THE NEXT FORTRAN RECORD. THE DIFFERENCE BETWEEN BAFRINDEX AND
C BAFRINDEXL IS THE KIND TYPE OF INTERGERS IN THE ARGUMENT LIST
C
C PROGRAM HISTORY LOG:
C 1999-01-21 IREDELL
C 2009-04-20 J. WANG
C
C USAGE: CALL BAFRINDEX(LU,IB,LX,IX)
C INPUT ARGUMENTS:
C LU INTEGER LOGICAL UNIT TO READ
C IF LU<=0, THEN DETERMINE IX FROM LX
C IB INTEGER FORTRAN RECORD START BYTE
C (FOR THE FIRST FORTRAN RECORD, IB SHOULD BE 0)
C LX INTEGER RECORD LENGTH IN BYTES IF LU<=0
C
C OUTPUT ARGUMENTS:
C LX INTEGER RECORD LENGTH IN BYTES IF LU>0,
C OR LX=-1 FOR I/O ERROR (PROBABLE END OF FILE),
C OR LX=-2 FOR I/O ERROR (INVALID FORTRAN RECORD)
C IX INTEGER START BYTE FOR THE NEXT FORTRAN RECORD
C (COMPUTED ONLY IF LX>=0)
C
C SUBPROGRAMS CALLED:
C BAFRINDEXL BYTE-ADDRESSABLE FORTRAN RECORD INDEX
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 90
C
C$$$
!
IMPLICIT NONE
INTEGER,INTENT(IN):: LU,IB
INTEGER,INTENT(INOUT):: LX
INTEGER,INTENT(OUT):: IX
integer(kind=8) :: LONG_IB,LONG_LX ,LONG_IX
!
LONG_IB=IB
LONG_LX=LX
call BAFRINDEXL(LU,LONG_IB,LONG_LX,LONG_IX)
LX=LONG_LX
IX=LONG_IX
return
end SUBROUTINE BAFRINDEX
C-----------------------------------------------------------------------
SUBROUTINE BAFRINDEXL(LU,IB,LX,IX)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: BAFRINDEXL BYTE-ADDRESSABLE FORTRAN RECORD INDEX
C PRGMMR: IREDELL ORG: W/NMC23 DATE: 1999-01-21
C
C ABSTRACT: THIS SUBPROGRAM EITHER READS AN UNFORMATTED FORTRAN RECORD
C AND RETURN ITS LENGTH AND START BYTE OF THE NEXT FORTRAN RECORD;
C OR GIVEN THE RECORD LENGTH, WITHOUT I/O IT DETERMINES THE START BYTE
C OF THE NEXT FORTRAN RECORD.
C
C PROGRAM HISTORY LOG:
C 1999-01-21 IREDELL
C 2009-04-20 J. WANG
C
C USAGE: CALL BAFRINDEXL(LU,IB,LX,IX)
C INPUT ARGUMENTS:
C LU INTEGER LOGICAL UNIT TO READ
C IF LU<=0, THEN DETERMINE IX FROM LX
C IB INTEGER(8) FORTRAN RECORD START BYTE
C (FOR THE FIRST FORTRAN RECORD, IB SHOULD BE 0)
C LX INTEGER(8) RECORD LENGTH IN BYTES IF LU<=0
C
C OUTPUT ARGUMENTS:
C LX INTEGER(8) RECORD LENGTH IN BYTES IF LU>0,
C OR LX=-1 FOR I/O ERROR (PROBABLE END OF FILE),
C OR LX=-2 FOR I/O ERROR (INVALID FORTRAN RECORD)
C IX INTEGER(8) START BYTE FOR THE NEXT FORTRAN RECORD
C (COMPUTED ONLY IF LX>=0)
C
C SUBPROGRAMS CALLED:
C BAREADL BYTE-ADDRESSABLE READ
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 90
C
C$$$
IMPLICIT NONE
INTEGER,INTENT(IN):: LU
INTEGER(KIND=8),INTENT(IN):: IB
INTEGER(KIND=8),INTENT(INOUT):: LX
INTEGER(KIND=8),INTENT(OUT):: IX
INTEGER(KIND=8),PARAMETER:: LBCW=4
INTEGER(KIND=LBCW):: BCW1,BCW2
INTEGER(KIND=8):: KR
CHARACTER(16) :: MACHINE_ENDIAN
LOGICAL :: DO_BYTESWAP
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C COMPARE FIRST BLOCK CONTROL WORD AND TRAILING BLOCK CONTROL WORD
IF(LU.GT.0) THEN
!
!-- set do_byteswap from machine endianness and file endianness
CALL CHK_ENDIANC(MACHINE_ENDIAN)
IF( LU<=999) THEN
IF( trim(MACHINE_ENDIAN)=="big_endian") THEN
DO_BYTESWAP=.false.
ELSEIF( trim(MACHINE_ENDIAN)=="little_endian") THEN
DO_BYTESWAP=.true.
ENDIF
ELSEIF(LU<=1999) THEN
IF( trim(MACHINE_ENDIAN)=="big_endian") THEN
DO_BYTESWAP=.true.
ELSEIF( trim(MACHINE_ENDIAN)=="little_endian") THEN
DO_BYTESWAP=.false.
ENDIF
ENDIF
!
!
!-- read out control word
CALL BAREADL(LU,IB,LBCW,KR,BCW1)
IF(DO_BYTESWAP) CALL Byteswap(BCW1,LBCW,1)
!
IF(KR.NE.LBCW) THEN
LX=-1
ELSE
CALL BAREADL(LU,IB+LBCW+BCW1,LBCW,KR,BCW2)
IF(DO_BYTESWAP) CALL Byteswap(BCW2,LBCW,1)
!
IF(KR.NE.LBCW.OR.BCW1.NE.BCW2) THEN
LX=-2
ELSE
LX=BCW1
ENDIF
ENDIF
!
!end luif
ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C COMPUTE START BYTE FOR THE NEXT FORTRAN RECORD
IF(LX.GE.0) IX=IB+LBCW+LX+LBCW
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
END SUBROUTINE BAFRINDEXL
C-----------------------------------------------------------------------
SUBROUTINE BAFRREAD(LU,IB,NB,KA,A)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: BAFRREAD BYTE-ADDRESSABLE FORTRAN RECORD READ
C PRGMMR: IREDELL ORG: W/NMC23 DATE: 1999-01-21
C
C ABSTRACT: THIS SUBPROGRAM IS CALLING BAFREAD TO REAS AN UNFORMATTED
C FORTRAN RECORD. THE DIFFERENCE BETWEEN BAFRREAD AND BAFRREADL IS
C THE KIND TYPE OF INTERGERS IN THE ARGUMENT LIST
C
C PROGRAM HISTORY LOG:
C 1999-01-21 IREDELL
C 2009-04-20 J. WANG
C
C USAGE: CALL BAFRREAD(LU,IB,NB,KA,A)
C INPUT ARGUMENTS:
C LU INTEGER LOGICAL UNIT TO READ
C IB INTEGER FORTRAN RECORD START BYTE
C (FOR THE FIRST FORTRAN RECORD, IB SHOULD BE 0)
C NB INTEGER NUMBER OF BYTES TO READ
C
C OUTPUT ARGUMENTS:
C KA INTEGER NUMBER OF BYTES IN FORTRAN RECORD
C (IN WHICH CASE THE NEXT FORTRAN RECORD
C SHOULD HAVE A START BYTE OF IB+KA),
C OR KA=-1 FOR I/O ERROR (PROBABLE END OF FILE),
C OR KA=-2 FOR I/O ERROR (INVALID FORTRAN RECORD),
C OR KA=-3 FOR I/O ERROR (REQUEST LONGER THAN RECORD)
C A CHARACTER*1 (NB) DATA READ
C
C SUBPROGRAMS CALLED:
C BAFRREADL BYTE-ADDRESSABLE READ
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 90
C
C$$$
!
IMPLICIT NONE
INTEGER,INTENT(IN):: LU,IB,NB
INTEGER,INTENT(OUT):: KA
CHARACTER,INTENT(OUT):: A(NB)
INTEGER(KIND=8) :: LONG_IB,LONG_NB,LONG_KA
!
if((IB<0.and.IB/=-1) .or. NB<0 ) THEN
print *,'WRONG: in BAFRREAD starting postion IB or read '// &
& 'data size NB < 0, STOP! Consider use BAFREADL and long integer'
KA=0
return
ENDIF
LONG_IB=IB
LONG_NB=NB
CALL BAFRREADL(LU,LONG_IB,LONG_NB,LONG_KA,A)
KA=LONG_KA
END SUBROUTINE BAFRREAD
C-----------------------------------------------------------------------
SUBROUTINE BAFRREADL(LU,IB,NB,KA,A)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: BAFRREADL BYTE-ADDRESSABLE FORTRAN RECORD READ
C PRGMMR: IREDELL ORG: W/NMC23 DATE: 1999-01-21
C
C ABSTRACT: THIS SUBPROGRAM READS AN UNFORMATTED FORTRAN RECORD
C
C PROGRAM HISTORY LOG:
C 1999-01-21 IREDELL
C 2009-04-20 J. WANG
C
C USAGE: CALL BAFRREADL(LU,IB,NB,KA,A)
C INPUT ARGUMENTS:
C LU INTEGER LOGICAL UNIT TO READ
C IB INTEGER(8) FORTRAN RECORD START BYTE
C (FOR THE FIRST FORTRAN RECORD, IB SHOULD BE 0)
C NB INTEGER(8) NUMBER OF BYTES TO READ
C
C OUTPUT ARGUMENTS:
C KA INTEGER(8) NUMBER OF BYTES IN FORTRAN RECORD
C (IN WHICH CASE THE NEXT FORTRAN RECORD
C SHOULD HAVE A START BYTE OF IB+KA),
C OR KA=-1 FOR I/O ERROR (PROBABLE END OF FILE),
C OR KA=-2 FOR I/O ERROR (INVALID FORTRAN RECORD),
C OR KA=-3 FOR I/O ERROR (REQUEST LONGER THAN RECORD)
C A CHARACTER*1 (NB) DATA READ
C
C SUBPROGRAMS CALLED:
C BAFRINDEXL BYTE-ADDRESSABLE FORTRAN RECORD INDEX
C BAREADL BYTE-ADDRESSABLE READ
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 90
C
C$$$
IMPLICIT NONE
INTEGER,INTENT(IN):: LU
INTEGER(kind=8),INTENT(IN):: IB,NB
INTEGER(kind=8),INTENT(OUT):: KA
CHARACTER,INTENT(OUT):: A(NB)
INTEGER(kind=8),PARAMETER:: LBCW=4
INTEGER(kind=8):: LX,IX
INTEGER(kind=8):: KR
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C VALIDATE FORTRAN RECORD
CALL BAFRINDEXL(LU,IB,LX,IX)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C READ IF VALID
IF(LX.LT.0) THEN
KA=LX
ELSEIF(LX.LT.NB) THEN
KA=-3
ELSE
CALL BAREADL(LU,IB+LBCW,NB,KR,A)
IF(KR.NE.NB) THEN
KA=-1
ELSE
KA=LBCW+LX+LBCW
ENDIF
ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
END SUBROUTINE BAFRREADL
C-----------------------------------------------------------------------
SUBROUTINE BAFRWRITE(LU,IB,NB,KA,A)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: BAFRWRITE BYTE-ADDRESSABLE FORTRAN RECORD WRITE
C PRGMMR: IREDELL ORG: W/NMC23 DATE: 1999-01-21
C
C ABSTRACT: THIS SUBPROGRAM IS CALLING BAFRWRITE TO WRITE AN UNFORMATTED
C FORTRAN RECORD. THE DIFFERENCE BETWEEN BAFRWRITE AND BAFRWRITEL IS
C THE KIND TYPE OF INTERGERS IN THE ARGUMENT LIST
C
C PROGRAM HISTORY LOG:
C 1999-01-21 IREDELL
C 2009-04-20 J. WANG
C
C USAGE: CALL BAFRWRITE(LU,IB,NB,KA,A)
C INPUT ARGUMENTS:
C LU INTEGER LOGICAL UNIT TO WRITE
C IB INTEGER FORTRAN RECORD START BYTE
C (FOR THE FIRST FORTRAN RECORD, IB SHOULD BE 0)
C NB INTEGER NUMBER OF BYTES TO WRITE
C A CHARACTER*1 (NB) DATA TO WRITE
C
C OUTPUT ARGUMENTS:
C KA INTEGER NUMBER OF BYTES IN FORTRAN RECORD
C (IN WHICH CASE THE NEXT FORTRAN RECORD
C SHOULD HAVE A START BYTE OF IB+KA),
C OR KA=-1 FOR I/O ERROR
C
C SUBPROGRAMS CALLED:
C BAWRITEL BYTE-ADDRESSABLE WRITE
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 90
C
C$$$
!
IMPLICIT NONE
INTEGER,INTENT(IN):: LU,IB,NB
INTEGER,INTENT(OUT):: KA
CHARACTER,INTENT(IN):: A(NB)
INTEGER(KIND=8) :: LONG_IB,LONG_NB,LONG_KA
!
if((IB<0.and.IB/=-1) .or. NB<0 ) THEN
print *,'WRONG: in BAFRWRITE starting postion IB or read '// &
& 'data size NB <0, STOP! ' // &
& 'Consider use BAFRRWRITEL and long integer'
KA=0
return
ENDIF
LONG_IB=IB
LONG_NB=NB
CALL BAFRWRITEL(LU,LONG_IB,LONG_NB,LONG_KA,A)
KA=LONG_KA
!
END SUBROUTINE BAFRWRITE
C-----------------------------------------------------------------------
SUBROUTINE BAFRWRITEL(LU,IB,NB,KA,A)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: BAFRWRITEL BYTE-ADDRESSABLE FORTRAN RECORD WRITE
C PRGMMR: IREDELL ORG: W/NMC23 DATE: 1999-01-21
C
C ABSTRACT: THIS SUBPROGRAM WRITES AN UNFORMATTED FORTRAN RECORD
C
C PROGRAM HISTORY LOG:
C 1999-01-21 IREDELL
C 2009-04-20 J. WANG
C
C USAGE: CALL BAFRWRITEL(LU,IB,NB,KA,A)
C INPUT ARGUMENTS:
C LU INTEGER LOGICAL UNIT TO WRITE
C IB INTEGER(8) FORTRAN RECORD START BYTE
C (FOR THE FIRST FORTRAN RECORD, IB SHOULD BE 0)
C NB INTEGER(8) NUMBER OF BYTES TO WRITE
C A CHARACTER*1 (NB) DATA TO WRITE
C
C OUTPUT ARGUMENTS:
C KA INTEGER(8) NUMBER OF BYTES IN FORTRAN RECORD
C (IN WHICH CASE THE NEXT FORTRAN RECORD
C SHOULD HAVE A START BYTE OF IB+KA),
C OR KA=-1 FOR I/O ERROR
C
C SUBPROGRAMS CALLED:
C BAWRITEL BYTE-ADDRESSABLE WRITE
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 90
C
C$$$
IMPLICIT NONE
INTEGER,INTENT(IN):: LU
INTEGER(KIND=8),INTENT(IN):: IB,NB
INTEGER(kind=8),INTENT(OUT):: KA
CHARACTER,INTENT(IN):: A(NB)
!
INTEGER(kind=8),PARAMETER:: LBCW=4
INTEGER(kind=LBCW):: BCW
INTEGER(kind=8):: KR
INTEGER(LBCW):: BCW2,LBCW2
CHARACTER(16) :: MACHINE_ENDIAN
LOGICAL :: DO_BYTESWAP
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C WRITE DATA BRACKETED BY BLOCK CONTROL WORDS
!
!-- set do_byteswap from machine endianness and file endianness
CALL CHK_ENDIANC(MACHINE_ENDIAN)
IF( LU<=999) THEN
IF( trim(MACHINE_ENDIAN)=="big_endian") THEN
DO_BYTESWAP=.false.
ELSEIF( trim(MACHINE_ENDIAN)=="little_endian") THEN
DO_BYTESWAP=.true.
ENDIF
ELSEIF(LU<=1999) THEN
IF( trim(MACHINE_ENDIAN)=="big_endian") THEN
DO_BYTESWAP=.true.
ELSEIF( trim(MACHINE_ENDIAN)=="little_endian") THEN
DO_BYTESWAP=.false.
ENDIF
ENDIF
!
!
BCW=NB
IF(DO_BYTESWAP) CALL Byteswap(BCW,LBCW,1)
CALL BAWRITEL(LU,IB,LBCW,KR,BCW)
IF(KR.NE.LBCW) THEN
KA=-1
ELSE
CALL BAWRITEL(LU,IB+LBCW,NB,KR,A)
IF(KR.NE.NB) THEN
KA=-1
ELSE
CALL BAWRITEL(LU,IB+LBCW+NB,LBCW,KR,BCW)
IF(KR.NE.LBCW) THEN
KA=-1
ELSE
KA=LBCW+NB+LBCW
ENDIF
ENDIF
ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
END SUBROUTINE BAFRWRITEL