wrfv2_fire/var/external/bufr/iupvs1.inc

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