icbfms.f

Go to the documentation of this file.

C> @file
C> @brief Test whether a character string is "missing"

C> This function provides a handy way to check whether a
C> character string returned from a previous call to subroutine
C> readlc() was encoded as "missing" (all bits set to 1)
C> within the actual BUFR data subset.
C>
C> @author J. Ator
C> @date 2012-06-07
C>
C> @param[in] STR - character*(*): String
C> @param[in] LSTR - integer: Length of string, i.e. number of
C>                   characters within STR to be tested
C>
C> @returns icbfms  -  integer:
C>                    - 0 = STR is not "missing"
C>                    - 1 = STR is "missing"
C>
C> @remarks
C> - The use of an integer return code allows this function
C> to be called in a logical context from application programs
C> written in C as well as in Fortran.
C>
C> <b>Program history log:</b>
C> - 2012-06-07  J. Ator    -- Original author
C> - 2015-03-10  J. Woollen -- Improved logic for testing legacy cases
C>                           prior to BUFRLIB V10.2.0
C> - 2016-02-12  J. Ator    -- Modified for CRAYFTN compatibility
C>
    INTEGER FUNCTION icbfms ( STR, LSTR )

    character*(*)   str

    character*8 strz
    real*8      rl8z

    character*16    zz

    character*16    zm_be
    parameter( zm_be = '202020E076483742' )
C*      10E10 stored as hexadecimal on a big-endian system.

    character*16    zm_le
    parameter( zm_le = '42374876E8000000' )
C*      10E10 stored as hexadecimal on a little-endian system.

    equivalence(strz,rl8z)

C-----------------------------------------------------------------------

    icbfms = 0

    numchr = min(lstr,len(str))

C*  Beginning with version 10.2.0 of the BUFRLIB, "missing" strings
C*  have always been explicitly encoded with all bits set to 1,
C*  which is the correct encoding per WMO regulations.  However,
C*  prior to version 10.2.0, the BUFRLIB stored "missing" strings by
C*  encoding the REAL*8 value of 10E10 into the string, so the
C*  following logic attempts to identify some of these earlier
C   cases, at least for strings between 4 and 8 bytes in length.

    IF ( numchr.GE.4 .AND. numchr.LE.8 ) THEN
        DO ii = 1, numchr
        strz(ii:ii) = str(ii:ii)
        END DO
        WRITE (zz,'(Z16.16)') rl8z
        i = 2*(8-numchr)+1
        n = 16
        IF ( zz(i:n).EQ.zm_be(i:n) .OR. zz(i:n).EQ.zm_le(i:n) ) THEN
        icbfms = 1
        RETURN
        END IF
    END IF

C*  Otherwise, the logic below will check for "missing" strings of
C*  any length which are correctly encoded with all bits set to 1,
C*  including those encoded by BUFRLIB version 10.2.0 or later.

    DO i=1,numchr
       IF ( iupm(str(i:i),8).NE.255 ) RETURN
    ENDDO

    icbfms = 1

    RETURN
    END