var/external/bufr/iupvs01.f

   1       FUNCTION IUPVS01(LUNIT,S01MNEM)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    IUPVS01
   6 C   PRGMMR: ATOR             ORG: NP12       DATE: 2005-11-29
   7 C
   8 C ABSTRACT: THIS FUNCTION UNPACKS AND RETURNS A SPECIFIED INTEGER VALUE
   9 C   FROM SECTION 0 OR SECTION 1 OF THE LAST BUFR MESSAGE THAT WAS READ
  10 C   FROM LOGICAL UNIT NUMBER LUNIT VIA BUFR ARCHIVE LIBRARY SUBROUTINE
  11 C   READMG, READERME OR EQUIVALENT.  IT WILL WORK ON ANY MESSAGE ENCODED
  12 C   USING BUFR EDITION 2, 3 OR 4, AND THE VALUE TO BE UNPACKED IS
  13 C   SPECIFIED VIA THE MNEMONIC S01MNEM (SEE THE DOCBLOCK OF BUFR ARCHIVE
  14 C   LIBRARY FUNCTION IUPBS01 FOR A LISTING OF POSSIBLE VALUES FOR
  15 C   S01MNEM).  NOTE THAT THIS FUNCTION IS SIMILAR TO BUFR ARCHIVE
  16 C   LIBRARY FUNCTION IUPBS01 EXCEPT THAT IT OPERATES ON A BUFR MESSAGE
  17 C   THAT HAS ALREADY BEEN READ INTO THE INTERNAL BUFR ARCHIVE LIBRARY
  18 C   ARRAYS (VIA A PREVIOUS CALL TO READMG, READERME, ETC.) RATHER THAN
  19 C   ON A BUFR MESSAGE PASSED DIRECTLY INTO THE FUNCTION VIA A MEMORY
  20 C   ARRAY.
  21 C
  22 C PROGRAM HISTORY LOG:
  23 C 2005-11-29  J. ATOR    -- ORIGINAL AUTHOR
  24 C
  25 C USAGE:    IUPVS01 (LUNIT, S01MNEM)
  26 C   INPUT ARGUMENT LIST:
  27 C     LUNIT    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
  28 C     S01MNEM  - CHARACTER*(*): MNEMONIC SPECIFYING VALUE TO BE
  29 C                UNPACKED FROM SECTION 0 OR SECTION 1 OF BUFR MESSAGE
  30 C                  (SEE DOCBLOCK OF FUNCTION IUPBS01 FOR LISTING OF
  31 C                  POSSIBLE VALUES)
  32 C
  33 C   OUTPUT ARGUMENT LIST:
  34 C     IUPVS01   - INTEGER: UNPACKED INTEGER VALUE
  35 C                  -1 = THE INPUT S01MNEM MNEMONIC WAS INVALID
  36 C
  37 C REMARKS:
  38 C    THIS ROUTINE CALLS:        BORT     IUPBS01  STATUS
  39 C    THIS ROUTINE IS CALLED BY: None
  40 C                               Normally called only by application
  41 C                               programs.
  42 C
  43 C ATTRIBUTES:
  44 C   LANGUAGE: FORTRAN 77
  45 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  46 C
  47 C$$$
  48
  49       INCLUDE 'bufrlib.prm'
  50
  51       COMMON /BITBUF/ MAXBYT,IBIT,IBAY(MXMSGLD4),MBYT(NFILES),
  52      .                MBAY(MXMSGLD4,NFILES)
  53
  54       CHARACTER*(*)   S01MNEM
  55
  56 C-----------------------------------------------------------------------
  57 C-----------------------------------------------------------------------
  58
  59 C  CHECK THE FILE STATUS
  60 C  ---------------------
  61
  62       CALL STATUS(LUNIT,LUN,ILST,IMST)
  63       IF(ILST.EQ.0) GOTO 900
  64       IF(ILST.GT.0) GOTO 901
  65       IF(IMST.EQ.0) GOTO 902
  66
  67 C  UNPACK THE REQUESTED VALUE
  68 C  --------------------------
  69
  70       IUPVS01 = IUPBS01(MBAY(1,LUN),S01MNEM)
  71
  72 C  EXITS
  73 C  -----
  74
  75       RETURN
  76 900   CALL BORT('BUFRLIB: IUPVS01 - INPUT BUFR FILE IS CLOSED, IT '//
  77      . 'MUST BE OPEN FOR INPUT')
  78 901   CALL BORT('BUFRLIB: IUPVS01 - INPUT BUFR FILE IS OPEN FOR '//
  79      . 'OUTPUT, IT MUST BE OPEN FOR INPUT')
  80 902   CALL BORT('BUFRLIB: IUPVS01 - A MESSAGE MUST BE OPEN IN INPUT '//
  81      . 'BUFR FILE, NONE ARE')
  82       END