stntbia.f

Go to the documentation of this file.

C> @file
C> @author ATOR @date 2009-03-23
    
C> THIS SUBROUTINE STORES A NEW ENTRY WITHIN INTERNAL BUFR
C>   TABLE A.
C>
C> PROGRAM HISTORY LOG:
C> 2009-03-23  J. ATOR    -- ORIGINAL AUTHOR
C> 2014-12-10  J. ATOR    -- USE MODULES INSTEAD OF COMMON BLOCKS
C>
C> USAGE:    CALL STNTBIA ( N, LUN, NUMB, NEMO, CELSQ )
C>   INPUT ARGUMENT LIST:
C>       N      - INTEGER: STORAGE INDEX INTO INTERNAL TABLE A
C>     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL TABLE A
C>    NUMB      - CHARACTER*6: FXY NUMBER FOR NEW TABLE A ENTRY (IN
C>                FORMAT FXXYYY)
C>    NEMO      - CHARACTER*8: MNEMONIC CORRESPONDING TO NUMB
C>   CELSQ      - CHARACTER*55: SEQUENCE DESCRIPTION CORRESPONDING
C>                TO NUMB
C>
C> REMARKS:
C>    THIS ROUTINE CALLS:        BORT     DIGIT
C>    THIS ROUTINE IS CALLED BY: RDUSDX   READS3   STBFDX
C>                               Not normally called by application
C>                               programs.
C>
    SUBROUTINE stntbia ( N, LUN, NUMB, NEMO, CELSQ )

    USE moda_tababd

    CHARACTER*128 bort_str

    CHARACTER*(*) numb, nemo, celsq

    LOGICAL digit

C-----------------------------------------------------------------------
C-----------------------------------------------------------------------

C   Confirm that neither NEMO nor NUMB has already been defined
C   within the internal BUFR Table A (in COMMON /TABABD/) for
C   the given LUN.

    DO n=1,ntba(lun)
      IF(numb(4:6).EQ.taba(n,lun)(1: 3)) goto 900
      IF(nemo(1:8).EQ.taba(n,lun)(4:11)) goto 901
    ENDDO

C   Store the values within the internal BUFR Table A.

    taba(n,lun)( 1: 3) = numb(4:6)
    taba(n,lun)( 4:11) = nemo(1:8)
    taba(n,lun)(13:67) = celsq(1:55)

C   Decode and store the message type and subtype.

    IF ( digit( nemo(3:8) ) ) THEN
c  ....   Message type & subtype obtained directly from Table A mnemonic
        READ ( nemo,'(2X,2I3)') mtyp, msbt
        idna(n,lun,1) = mtyp
        idna(n,lun,2) = msbt
    ELSE
c  ....   Message type obtained from Y value of Table A seq. descriptor
        READ ( numb(4:6),'(I3)') idna(n,lun,1)
c  ....   Message subtype hardwired to ZERO
        idna(n,lun,2) = 0
    ENDIF

C   Update the count of internal Table A entries.

        ntba(lun) = n

    RETURN
900 WRITE(bort_str,'("BUFRLIB: STNTBIA - TABLE A FXY VALUE (",A,") '
     .     //'HAS ALREADY BEEN DEFINED (DUPLICATE)")') numb
    CALL bort(bort_str)
901 WRITE(bort_str,'("BUFRLIB: STNTBIA - TABLE A MNEMONIC (",A,") '
     .     //'HAS ALREADY BEEN DEFINED (DUPLICATE)")') nemo
    CALL bort(bort_str)
    END