var/external/bufr/nmsub.f

   1       FUNCTION NMSUB(LUNIT)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    NMSUB
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS FUNCTION RETURNS THE NUMBER OF SUBSETS IN A BUFR
   9 C   MESSAGE OPEN FOR INPUT VIA A PREVIOUS CALL TO BUFR ARCHIVE LIBRARY
  10 C   SUBROUTINE READMG OR EQUIVALENT.  THE SUBSETS THEMSELVES DO NOT
  11 C   HAVE TO BE READ.
  12 C
  13 C PROGRAM HISTORY LOG:
  14 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  15 C 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
  16 C                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
  17 C                           ROUTINE "BORT"
  18 C 1999-11-18  J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
  19 C                           OPENED AT ONE TIME INCREASED FROM 10 TO 32
  20 C                           (NECESSARY IN ORDER TO PROCESS MULTIPLE
  21 C                           BUFR FILES UNDER THE MPI)
  22 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  23 C                           INTERDEPENDENCIES
  24 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED
  25 C                           DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
  26 C                           MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
  27 C                           TERMINATES ABNORMALLY
  28 C
  29 C USAGE:    NMSUB (LUNIT)
  30 C   INPUT ARGUMENT LIST:
  31 C     LUNIT    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
  32 C
  33 C   OUTPUT ARGUMENT LIST:
  34 C     NMSUB    - INTEGER: NUMBER OF SUBSETS IN BUFR MESSAGE
  35 C
  36 C REMARKS:
  37 C    THIS ROUTINE CALLS:        BORT     STATUS
  38 C    THIS ROUTINE IS CALLED BY: UFBMNS   UFBPOS   UFBTAB   UFBTAM
  39 C                               Also called by application programs.
  40 C
  41 C ATTRIBUTES:
  42 C   LANGUAGE: FORTRAN 77
  43 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  44 C
  45 C$$$
  46
  47       INCLUDE 'bufrlib.prm'
  48
  49       COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES),
  50      .                INODE(NFILES),IDATE(NFILES)
  51
  52 C-----------------------------------------------------------------------
  53 C-----------------------------------------------------------------------
  54
  55       NMSUB = 0
  56
  57 C  CHECK THE FILE STATUS
  58 C  ---------------------
  59
  60       CALL STATUS(LUNIT,LUN,IL,IM)
  61       IF(IL.EQ.0) GOTO 900
  62       IF(IL.GT.0) GOTO 901
  63       IF(IM.EQ.0) GOTO 902
  64
  65       NMSUB = MSUB(LUN)
  66
  67 C  EXITS
  68 C  -----
  69
  70       RETURN
  71 900   CALL BORT('BUFRLIB: NMSUB - INPUT BUFR FILE IS CLOSED, IT MUST '//
  72      . 'BE OPEN FOR INPUT')
  73 901   CALL BORT('BUFRLIB: NMSUB - INPUT BUFR FILE IS OPEN FOR OUTPUT,'//
  74      . ' IT MUST BE OPEN FOR INPUT')
  75 902   CALL BORT('BUFRLIB: NMSUB - A MESSAGE MUST BE OPEN IN INPUT '//
  76      . 'BUFR FILE, NONE ARE')
  77       END