NCEPLIBS-bufr  12.0.0
icbfms.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Test whether a character string is "missing"
3 C>
4 C> @author J. Ator @date 2012-06-07
5 
6 C> This function provides a handy way to check whether a
7 C> character string returned from a previous call to subroutine
8 C> readlc() was encoded as "missing" (all bits set to 1)
9 C> within the actual BUFR data subset.
10 C>
11 C> @param[in] STR -- character*(*): String
12 C> @param[in] LSTR -- integer: Length of string, i.e. number of
13 C> characters within STR to be tested
14 C> @returns icbfms -- integer:
15 C> - 0 = STR is not "missing"
16 C> - 1 = STR is "missing"
17 C>
18 C> @remarks
19 C> - The use of an integer return code allows this function
20 C> to be called in a logical context from application programs
21 C> written in C as well as in Fortran.
22 C>
23 C> @author J. Ator @date 2012-06-07
24  RECURSIVE FUNCTION icbfms ( STR, LSTR ) RESULT ( IRET )
25 
26  USE modv_im8b
27 
28  CHARACTER*(*) str
29 
30  CHARACTER*8 strz
31  real*8 rl8z
32 
33  CHARACTER*16 zz
34 
35  CHARACTER*16 zm_be
36  parameter( zm_be = '202020E076483742' )
37 C* 10E10 stored as hexadecimal on a big-endian system.
38 
39  CHARACTER*16 zm_le
40  parameter( zm_le = '42374876E8000000' )
41 C* 10E10 stored as hexadecimal on a little-endian system.
42 
43  equivalence(strz,rl8z)
44 
45 C-----------------------------------------------------------------------
46 
47 C Check for I8 integers.
48 
49  IF ( im8b ) THEN
50  im8b = .false.
51 
52  CALL x84 ( lstr, my_lstr, 1 )
53  iret = icbfms( str, my_lstr )
54 
55  im8b = .true.
56  RETURN
57  END IF
58 
59  iret = 0
60 
61  numchr = min(lstr,len(str))
62 
63 C* Beginning with version 10.2.0 of the BUFRLIB, "missing" strings
64 C* have always been explicitly encoded with all bits set to 1,
65 C* which is the correct encoding per WMO regulations. However,
66 C* prior to version 10.2.0, the BUFRLIB stored "missing" strings by
67 C* encoding the REAL*8 value of 10E10 into the string, so the
68 C* following logic attempts to identify some of these earlier
69 C cases, at least for strings between 4 and 8 bytes in length.
70 
71  IF ( numchr.GE.4 .AND. numchr.LE.8 ) THEN
72  DO ii = 1, numchr
73  strz(ii:ii) = str(ii:ii)
74  END DO
75  WRITE (zz,'(Z16.16)') rl8z
76  i = 2*(8-numchr)+1
77  n = 16
78  IF ( zz(i:n).EQ.zm_be(i:n) .OR. zz(i:n).EQ.zm_le(i:n) ) THEN
79  iret = 1
80  RETURN
81  END IF
82  END IF
83 
84 C* Otherwise, the logic below will check for "missing" strings of
85 C* any length which are correctly encoded with all bits set to 1,
86 C* including those encoded by BUFRLIB version 10.2.0 or later.
87 
88  DO ii=1,numchr
89  strz(1:1) = str(ii:ii)
90  IF ( iupm(strz(1:1),8).NE.255 ) RETURN
91  ENDDO
92 
93  iret = 1
94 
95  RETURN
96  END
recursive function icbfms(STR, LSTR)
This function provides a handy way to check whether a character string returned from a previous call ...
Definition: icbfms.f:25
recursive function iupm(CBAY, NBITS)
Decode an integer value from a character string.
Definition: iupm.f:20
This module declares and initializes the IM8B variable.
logical, public im8b
Status indicator to keep track of whether all future calls to BUFRLIB subroutines and functions from ...
subroutine x84(IIN8, IOUT4, NVAL)
Encode one or more 8-byte integer values as 4-byte integer values.
Definition: x84.F:19