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> @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> | Date | Programmer | Comments |
C> | -----|------------|----------|
C> | 2012-06-07 | J. Ator | Original author |
C> | 2015-03-10 | J. Woollen | Improved logic for testing legacy cases 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