icbfms.f

Go to the documentation of this file.

C> @file
C> @brief Test whether a character string is "missing"
C>
C> @author J. Ator @date 2012-06-07
 
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> @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> @author J. Ator @date 2012-06-07
        RECURSIVE FUNCTION icbfms ( STR, LSTR ) RESULT ( IRET )
 
        USE modv_im8b
 
        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-----------------------------------------------------------------------
 
C       Check for I8 integers.
 
        IF ( im8b ) THEN
            im8b = .false.
 
            CALL x84 ( lstr, my_lstr, 1 )
            iret = icbfms( str, my_lstr )
 
            im8b = .true.
            RETURN
        END IF
 
        iret = 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
                iret = 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 ii=1,numchr
           strz(1:1) = str(ii:ii)
           IF ( iupm(strz(1:1),8).NE.255 ) RETURN
        ENDDO
 
        iret = 1
 
        RETURN
        END