NCEPLIBS-bufr  11.7.0
 All Data Structures Files Functions Variables Pages
icbfms.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Test whether a character string is "missing"
3 
4 C> This function provides a handy way to check whether a
5 C> character string returned from a previous call to subroutine
6 C> readlc() was encoded as "missing" (all bits set to 1)
7 C> within the actual BUFR data subset.
8 C>
9 C> @author J. Ator
10 C> @date 2012-06-07
11 C>
12 C> @param[in] STR -- character*(*): String
13 C> @param[in] LSTR -- integer: Length of string, i.e. number of
14 C> characters within STR to be tested
15 C> @returns icbfms -- integer:
16 C> - 0 = STR is not "missing"
17 C> - 1 = STR is "missing"
18 C>
19 C> @remarks
20 C> - The use of an integer return code allows this function
21 C> to be called in a logical context from application programs
22 C> written in C as well as in Fortran.
23 C>
24 C> <b>Program history log:</b>
25 C> | Date | Programmer | Comments |
26 C> | -----|------------|----------|
27 C> | 2012-06-07 | J. Ator | Original author |
28 C> | 2015-03-10 | J. Woollen | Improved logic for testing legacy cases prior to BUFRLIB V10.2.0 |
29 C> | 2016-02-12 | J. Ator | Modified for CRAYFTN compatibility |
30 C>
31  INTEGER FUNCTION icbfms ( STR, LSTR )
32 
33  character*(*) str
34 
35  character*8 strz
36  real*8 rl8z
37 
38  character*16 zz
39 
40  character*16 zm_be
41  parameter( zm_be = '202020E076483742' )
42 C* 10E10 stored as hexadecimal on a big-endian system.
43 
44  character*16 zm_le
45  parameter( zm_le = '42374876E8000000' )
46 C* 10E10 stored as hexadecimal on a little-endian system.
47 
48  equivalence(strz,rl8z)
49 
50 C-----------------------------------------------------------------------
51 
52  icbfms = 0
53 
54  numchr = min(lstr,len(str))
55 
56 C* Beginning with version 10.2.0 of the BUFRLIB, "missing" strings
57 C* have always been explicitly encoded with all bits set to 1,
58 C* which is the correct encoding per WMO regulations. However,
59 C* prior to version 10.2.0, the BUFRLIB stored "missing" strings by
60 C* encoding the REAL*8 value of 10E10 into the string, so the
61 C* following logic attempts to identify some of these earlier
62 C cases, at least for strings between 4 and 8 bytes in length.
63 
64  IF ( numchr.GE.4 .AND. numchr.LE.8 ) THEN
65  DO ii = 1, numchr
66  strz(ii:ii) = str(ii:ii)
67  END DO
68  WRITE (zz,'(Z16.16)') rl8z
69  i = 2*(8-numchr)+1
70  n = 16
71  IF ( zz(i:n).EQ.zm_be(i:n) .OR. zz(i:n).EQ.zm_le(i:n) ) THEN
72  icbfms = 1
73  RETURN
74  END IF
75  END IF
76 
77 C* Otherwise, the logic below will check for "missing" strings of
78 C* any length which are correctly encoded with all bits set to 1,
79 C* including those encoded by BUFRLIB version 10.2.0 or later.
80 
81  DO i=1,numchr
82  IF ( iupm(str(i:i),8).NE.255 ) RETURN
83  ENDDO
84 
85  icbfms = 1
86 
87  RETURN
88  END
INTEGER function icbfms(STR, LSTR)
This function provides a handy way to check whether a character string returned from a previous call ...
Definition: icbfms.f:31
function iupm(CBAY, NBITS)
THIS FUNCTION UNPACKS AND RETURNS A BINARY INTEGER WORD CONTAINED WITHIN NBITS BITS OF A CHARACTER ST...
Definition: iupm.f:40