var/external/bufr/stntbi.f

   1         SUBROUTINE STNTBI ( N, LUN, NUMB, NEMO, CELSQ )
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    STNTBI
   6 C   PRGMMR: ATOR            ORG: NP12       DATE: 2009-03-23
   7 C
   8 C ABSTRACT: THIS SUBROUTINE STORES A NEW ENTRY WITHIN INTERNAL BUFR
   9 C   TABLE B OR D, DEPENDING ON THE VALUE OF NUMB.
  10 C
  11 C PROGRAM HISTORY LOG:
  12 C 2009-03-23  J. ATOR    -- ORIGINAL AUTHOR
  13 C
  14 C USAGE:    CALL STNTBI ( N, LUN, NUMB, NEMO, CELSQ )
  15 C   INPUT ARGUMENT LIST:
  16 C       N      - INTEGER: STORAGE INDEX INTO INTERNAL TABLE B OR D
  17 C     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL TABLE B OR D
  18 C    NUMB      - CHARACTER*6: FXY NUMBER FOR NEW TABLE B OR D ENTRY
  19 C                (IN FORMAT FXXYYY)
  20 C    NEMO      - CHARACTER*8: MNEMONIC CORRESPONDING TO NUMB
  21 C   CELSQ      - CHARACTER*55: ELEMENT OR SEQUENCE DESCRIPTION
  22 C                CORRESPONDING TO NUMB
  23 C
  24 C REMARKS:
  25 C    THIS ROUTINE CALLS:        IFXY     NENUBD
  26 C    THIS ROUTINE IS CALLED BY: RDUSDX   STSEQ
  27 C                               Not normally called by application
  28 C                               programs.
  29 C
  30 C ATTRIBUTES:
  31 C   LANGUAGE: FORTRAN 77
  32 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  33 C
  34 C$$$
  35
  36         INCLUDE 'bufrlib.prm'
  37
  38         COMMON /TABABD/ NTBA(0:NFILES),NTBB(0:NFILES),NTBD(0:NFILES),
  39      .                  MTAB(MAXTBA,NFILES),IDNA(MAXTBA,NFILES,2),
  40      .                  IDNB(MAXTBB,NFILES),IDND(MAXTBD,NFILES),
  41      .                  TABA(MAXTBA,NFILES),TABB(MAXTBB,NFILES),
  42      .                  TABD(MAXTBD,NFILES)
  43
  44         CHARACTER*600 TABD
  45         CHARACTER*128 TABA, TABB
  46
  47         CHARACTER*(*) NUMB, NEMO, CELSQ
  48
  49 C-----------------------------------------------------------------------
  50 C-----------------------------------------------------------------------
  51
  52         CALL NENUBD ( NEMO, NUMB, LUN )
  53
  54         IF ( NUMB(1:1) .EQ. '0') THEN
  55             IDNB(N,LUN) = IFXY(NUMB)
  56             TABB(N,LUN)( 1: 6) = NUMB(1:6)
  57             TABB(N,LUN)( 7:14) = NEMO(1:8)
  58             TABB(N,LUN)(16:70) = CELSQ(1:55)
  59             NTBB(LUN) = N
  60         ELSE IF ( NUMB(1:1) .EQ. '3') THEN
  61             IDND(N,LUN) = IFXY(NUMB)
  62             TABD(N,LUN)( 1: 6) = NUMB(1:6)
  63             TABD(N,LUN)( 7:14) = NEMO(1:8)
  64             TABD(N,LUN)(16:70) = CELSQ(1:55)
  65             NTBD(LUN) = N
  66         ENDIF
  67
  68         RETURN
  69         END