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