var/external/bufr/igetntbi.f

   1         FUNCTION IGETNTBI ( LUN, CTB )
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    IGETNTBI
   6 C   PRGMMR: ATOR            ORG: NP12       DATE: 2009-03-23
   7 C
   8 C ABSTRACT: THIS FUNCTION RETURNS THE NEXT AVAILABLE INDEX FOR
   9 C   STORING AN ENTRY WITHIN INTERNAL BUFR TABLE CTB.
  10 C
  11 C PROGRAM HISTORY LOG:
  12 C 2009-03-23  J. ATOR    -- ORIGINAL AUTHOR
  13 C
  14 C USAGE:    CALL IGETNTBI ( LUN, CTB )
  15 C   INPUT ARGUMENT LIST:
  16 C     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
  17 C     CTB      - CHARACTER*1: INTERNAL BUFR TABLE FROM WHICH TO RETURN
  18 C                THE NEXT AVAILABLE INDEX ('A','B', OR 'D')
  19 C
  20 C   OUTPUT ARGUMENT LIST:
  21 C     IGETNTBI  - INTEGER: NEXT AVAILABLE INDEX IN TABLE CTB
  22 C
  23 C REMARKS:
  24 C    THIS ROUTINE CALLS:        BORT
  25 C    THIS ROUTINE IS CALLED BY: RDUSDX   READS3   STBFDX   STSEQ
  26 C                               Not normally called by application
  27 C                               programs.
  28 C
  29 C ATTRIBUTES:
  30 C   LANGUAGE: FORTRAN 77
  31 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  32 C
  33 C$$$
  34
  35         INCLUDE 'bufrlib.prm'
  36
  37         COMMON /TABABD/ NTBA(0:NFILES),NTBB(0:NFILES),NTBD(0:NFILES),
  38      .                  MTAB(MAXTBA,NFILES),IDNA(MAXTBA,NFILES,2),
  39      .                  IDNB(MAXTBB,NFILES),IDND(MAXTBD,NFILES),
  40      .                  TABA(MAXTBA,NFILES),TABB(MAXTBB,NFILES),
  41      .                  TABD(MAXTBD,NFILES)
  42
  43         CHARACTER*600 TABD
  44         CHARACTER*128 TABA, TABB, BORT_STR
  45         CHARACTER*1   CTB
  46
  47 C-----------------------------------------------------------------------
  48 C-----------------------------------------------------------------------
  49
  50         IF ( CTB .EQ. 'A' ) THEN
  51           IGETNTBI = NTBA(LUN) + 1
  52           IMAX = NTBA(0)
  53         ELSE IF ( CTB .EQ. 'B' ) THEN
  54           IGETNTBI = NTBB(LUN) + 1
  55           IMAX = NTBB(0)
  56         ELSE IF ( CTB .EQ. 'D' ) THEN
  57           IGETNTBI = NTBD(LUN) + 1
  58           IMAX = NTBD(0)
  59         ENDIF
  60         IF ( IGETNTBI .GT. IMAX ) GOTO 900
  61
  62         RETURN
  63 900     WRITE(BORT_STR,'("BUFRLIB: IGETNTBI - NUMBER OF INTERNAL TABLE'
  64      .    //'",A1," ENTRIES EXCEEDS THE LIMIT (",I4,")")') CTB, IMAX
  65         CALL BORT(BORT_STR)
  66         END