var/external/bufr/iupbs3.f

   1       FUNCTION IUPBS3(MBAY,S3MNEM)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    IUPBS3
   6 C   PRGMMR: ATOR             ORG: NP12       DATE: 2009-03-23
   7 C
   8 C ABSTRACT: THIS FUNCTION UNPACKS AND RETURNS A SPECIFIED INTEGER VALUE
   9 C   FROM SECTION 3 OF THE BUFR MESSAGE STORED IN ARRAY MBAY.  IT WILL
  10 C   WORK ON ANY MESSAGE ENCODED USING BUFR EDITION 2, 3 OR 4.  THE START
  11 C   OF THE BUFR MESSAGE (I.E. THE STRING "BUFR") MUST BE ALIGNED ON THE
  12 C   FIRST FOUR BYTES OF MBAY, AND THE VALUE TO BE UNPACKED IS SPECIFIED
  13 C   VIA THE MNEMONIC S3MNEM, AS EXPLAINED IN FURTHER DETAIL BELOW.
  14 C
  15 C PROGRAM HISTORY LOG:
  16 C 2009-03-23  J. ATOR    -- ORIGINAL AUTHOR
  17 C
  18 C USAGE:    IUPBS3 (MBAY, S3MNEM)
  19 C   INPUT ARGUMENT LIST:
  20 C     MBAY     - INTEGER: *-WORD PACKED BINARY ARRAY CONTAINING
  21 C                BUFR MESSAGE
  22 C     S3MNEM   - CHARACTER*(*): MNEMONIC SPECIFYING VALUE TO BE
  23 C                UNPACKED FROM SECTION 3 OF BUFR MESSAGE:
  24 C                  'NSUB'  = NUMBER OF DATA SUBSETS
  25 C                  'IOBS'  = FLAG INDICATING WHETHER THE MESSAGE
  26 C                            CONTAINS OBSERVED DATA:
  27 C                              0 = NO
  28 C                              1 = YES
  29 C                  'ICMP'  = FLAG INDICATING WHETHER THE MESSAGE
  30 C                            CONTAINS COMPRESSED DATA:
  31 C                              0 = NO
  32 C                              1 = YES
  33 C
  34 C   OUTPUT ARGUMENT LIST:
  35 C     IUPBS3   - INTEGER: UNPACKED INTEGER VALUE
  36 C                  -1 = THE INPUT S3MNEM MNEMONIC WAS INVALID
  37 C
  38 C REMARKS:
  39 C    THIS ROUTINE CALLS:        GETLENS  IUPB
  40 C    THIS ROUTINE IS CALLED BY: CKTABA   CPDXMM   DUMPBF   MESGBC
  41 C                               RDBFDX   READERME STNDRD   WRITLC
  42 C                               Also called by application programs.
  43 C
  44 C ATTRIBUTES:
  45 C   LANGUAGE: FORTRAN 77
  46 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  47 C
  48 C$$$
  49
  50         DIMENSION       MBAY(*)
  51
  52         CHARACTER*(*)   S3MNEM
  53
  54 C-----------------------------------------------------------------------
  55 C-----------------------------------------------------------------------
  56
  57 C       Call subroutine WRDLEN to initialize some important information
  58 C       about the local machine, just in case subroutine OPENBF hasn't
  59 C       been called yet.
  60
  61         CALL WRDLEN
  62
  63 C       Skip to the beginning of Section 3.
  64
  65         CALL GETLENS(MBAY,3,LEN0,LEN1,LEN2,LEN3,L4,L5)
  66         IPT = LEN0 + LEN1 + LEN2
  67
  68 C       Unpack the requested value.
  69
  70         IF(S3MNEM.EQ.'NSUB') THEN
  71             IUPBS3 = IUPB(MBAY,IPT+5,16)
  72         ELSE IF( (S3MNEM.EQ.'IOBS') .OR. (S3MNEM.EQ.'ICMP') ) THEN
  73             IVAL = IUPB(MBAY,IPT+7,8)
  74             IF(S3MNEM.EQ.'IOBS') THEN
  75                 IMASK = 128
  76             ELSE
  77                 IMASK = 64
  78             ENDIF
  79             IUPBS3 = MIN(1,IAND(IVAL,IMASK))
  80         ELSE
  81             IUPBS3 = -1
  82         ENDIF
  83
  84         RETURN
  85         END