stntbia.f

Go to the documentation of this file.

C> @file
C> @brief Store a new entry within the internal BUFR Table A.
C> @author Ator @date 2009-03-23
 
C> This subroutine stores a new entry within internal BUFR Table A.
C>
C> @param[in] N - integer: storage index into internal Table A.
C> @param[in] LUN - integer: I/O stream index into internal Table A.
C> @param[in] NUMB - character*6: FXY number for new Table A entry (in format FXXYYY).
C> @param[in] NEMO - character*8: mnemonic corresponding to NUMB.
C> @param[in] CELSQ - character*55: sequence description corresponding to NUMB.
C>
C> @author Ator @date 2009-03-23
        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