var/external/bufr/icbfms.f

   1         INTEGER FUNCTION ICBFMS ( STR, LSTR )
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    ICBFMS
   6 C   PRGMMR: J. ATOR          ORG: NP12       DATE: 2012-06-07
   7 C
   8 C ABSTRACT: THIS FUNCTION TESTS WHETHER THE INPUT CHARACTER STRING
   9 C   IS "MISSING" BY CHECKING IF ALL OF THE EQUIVALENT BITS ARE SET TO 1.
  10 C   IT IS SIMILAR TO BUFR ARCHIVE LIBRARY FUNCTION IBFMS, EXCEPT THAT
  11 C   IBFMS TESTS REAL*8 VALUES FOR EQUIVALENCE TO THE PARAMETER BMISS,
  12 C   WHEREAS ICBFMS CHECKS THAT ALL EQUIVALENT BITS ARE SET TO 1 AND IS
  13 C   THEREFORE A MORE PORTABLE AND RELIABLE TEST FOR USE WITH CHARACTER
  14 C   STRINGS.
  15 C
  16 C PROGRAM HISTORY LOG:
  17 C 2012-06-07  J. ATOR    -- ORIGINAL AUTHOR
  18 C
  19 C USAGE:    ICBFMS ( STR, LSTR )
  20 C   INPUT ARGUMENT LIST:
  21 C     STR      - CHARACTER*(*): STRING TO BE TESTED
  22 C     LSTR     - INTEGER: NUMBER OF CHARACTERS TO BE TESTED WITHIN STR
  23 C
  24 C   OUTPUT ARGUMENT LIST:
  25 C     ICBFMS   - INTEGER: RETURN CODE:
  26 C                0 - STR IS NOT "MISSING"
  27 C                1 - STR IS "MISSING"
  28 C
  29 C REMARKS:
  30 C    THIS ROUTINE CALLS:        IUPM
  31 C    THIS ROUTINE IS CALLED BY: RDCMPS   RDTREE   UFDUMP
  32 C                               Also called by application programs.
  33 C
  34 C ATTRIBUTES:
  35 C   LANGUAGE: FORTRAN 77
  36 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  37 C
  38 C$$$
  39
  40         INCLUDE 'bufrlib.prm'
  41
  42         CHARACTER*(*)   STR
  43
  44 C-----------------------------------------------------------------------
  45
  46         ICBFMS = 0
  47
  48         NUMCHR = MIN(LSTR,LEN(STR))
  49
  50 C*      Beginning with version 10.2.0 of the BUFRLIB, "missing" strings
  51 C*      are explicitly encoded with all bits set to 1.  However, this
  52 C*      wasn't the case for strings encoded with earlier versions of
  53 C*      BUFRLIB, so the following block can help identify "missing"
  54 C*      strings encoded with these earlier versions.
  55
  56         IF ( (NUMCHR.GE.4) .AND. ( STR(1:4).EQ.'B7Hv')) THEN
  57             ICBFMS = 1
  58             RETURN
  59         END IF
  60
  61 C*      Otherwise, the logic below will handle cases encoded using
  62 C*      BUFRLIB version 10.2.0 or later.
  63
  64         DO I=1,NUMCHR
  65            IF ( IUPM(STR(I:I),8).NE.255 ) RETURN
  66         ENDDO
  67
  68         ICBFMS = 1
  69
  70         RETURN
  71         END