var/external/bufr/ifbget.f

   1       FUNCTION IFBGET(LUNIT)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    IFBGET
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS FUNCTION CHECKS TO SEE IF ANY UNREAD SUBSETS ARE IN
   9 C   AN INPUT BUFR MESSAGE PREVIOUSLY OPENED BY BUFR ARCHIVE LIBRARY
  10 C   SUBROUTINE OPENMG OR OPENMB.
  11 C
  12 C PROGRAM HISTORY LOG:
  13 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  14 C 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
  15 C                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
  16 C                           ROUTINE "BORT"
  17 C 1999-11-18  J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
  18 C                           OPENED AT ONE TIME INCREASED FROM 10 TO 32
  19 C                           (NECESSARY IN ORDER TO PROCESS MULTIPLE
  20 C                           BUFR FILES UNDER THE MPI)
  21 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  22 C                           INTERDEPENDENCIES
  23 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED
  24 C                           DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
  25 C                           MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
  26 C                           TERMINATES ABNORMALLY
  27 C
  28 C USAGE:    IFBGET (LUNIT)
  29 C   INPUT ARGUMENT LIST:
  30 C     LUNIT    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
  31 C
  32 C   OUTPUT ARGUMENT LIST:
  33 C     IFBGET   - INTEGER: RETURN CODE:
  34 C                       0 = there is at least one more subset in the
  35 C                           message
  36 C                      -1 = there are no more subsets in the message
  37 C
  38 C REMARKS:
  39 C    THIS ROUTINE CALLS:        BORT     STATUS
  40 C    THIS ROUTINE IS CALLED BY: None
  41 C                               Normally called only by application
  42 C                               programs.
  43 C
  44 C ATTRIBUTES:
  45 C   LANGUAGE: FORTRAN 77
  46 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  47 C
  48 C$$$
  49
  50       INCLUDE 'bufrlib.prm'
  51
  52       COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES),
  53      .                INODE(NFILES),IDATE(NFILES)
  54
  55 C-----------------------------------------------------------------------
  56 C-----------------------------------------------------------------------
  57
  58 C  MAKE SURE A FILE/MESSAGE IS OPEN FOR INPUT
  59 C  ------------------------------------------
  60
  61       CALL STATUS(LUNIT,LUN,IL,IM)
  62       IF(IL.EQ.0) GOTO 900
  63       IF(IL.GT.0) GOTO 901
  64       IF(IM.EQ.0) GOTO 902
  65
  66 C  SEE IF THERE IS ANOTHER SUBSET IN THE MESSAGE
  67 C  ---------------------------------------------
  68
  69       IF(NSUB(LUN).LT.MSUB(LUN)) THEN
  70          IFBGET = 0
  71       ELSE
  72          IFBGET = -1
  73       ENDIF
  74
  75 C  EXITS
  76 C  -----
  77
  78       RETURN
  79 900   CALL BORT('BUFRLIB: IFBGET - INPUT BUFR FILE IS CLOSED, IT '//
  80      . 'MUST BE OPEN FOR INPUT')
  81 901   CALL BORT('BUFRLIB: IFBGET - INPUT BUFR FILE IS OPEN FOR '//
  82      . 'OUTPUT, IT MUST BE OPEN FOR INPUT')
  83 902   CALL BORT('BUFRLIB: IFBGET - A MESSAGE MUST BE OPEN IN INPUT '//
  84      . 'BUFR FILE, NONE ARE')
  85       END