gettagre.f

Go to the documentation of this file.

C> @file
C> @brief Check whether a Table B mnemonic references another
C> Table B mnemonic via an internal bitmap.

C> This subroutine determines whether a specified Table B mnemonic
C> references another Table B mnemonic within the same data subset
C> via an internal bitmap, and if so returns the referenced
C> mnemonic and its location within the subset.
C>
C> @author J. Ator
C> @date 2016-06-07
C>
C> @param[in] LUNIT  -- integer: Fortran logical unit number for
C>                      BUFR file
C> @param[in] TAGI   -- character*(*): Table B mnemonic
C> @param[in] NTAGI  -- integer: Ordinal occurrence of TAGI for
C>                      which TAGRE is to be returned, counting from
C>                      the beginning of the overall subset definition
C> @param[out] TAGRE -- character*(*): Table B mnemonic referenced by
C>                      TAGI via an internal bitmap
C> @param[out] NTAGRE -- integer: Ordinal occurrence of TAGRE
C>                       referenced by (NTAGI)th occurrence of TAGI,
C>                       counting from the beginning of the overall
C>                       subset definition
C> @param[out] IRET  -- integer: return code
C>                      - 0 = normal return
C>                      - -1 = TAGRE could not be found, or some
C>                             other error occurred
C>
C> <p>A data subset must already be in scope within the BUFRLIB
C> internal arrays for LUNIT, either via a previous call to one
C> of the [subset-reading subroutines](@ref hierarchy)
C> (when reading BUFR data subsets) or via a previous call to one
C> of the [message-writing subroutines](@ref hierarchy)
C> (when writing BUFR data subsets).
C>
C> <b>Program history log:</b>
C> | Date | Programmer | Comments |
C> | -----|------------|----------|
C> | 2016-06-07 | J. Ator | Original author |
C>
    SUBROUTINE gettagre ( LUNIT, TAGI, NTAGI, TAGRE, NTAGRE, IRET )

    USE moda_usrint
    USE moda_msgcwd
    USE moda_tables

    CHARACTER*(*) tagi, tagre

    CHARACTER*10 tagtmp

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

    iret = -1

C   Get LUN from LUNIT.

    CALL status( lunit, lun, il, im )
    IF ( il .EQ. 0 ) RETURN
    IF ( inode(lun) .NE. inv(1,lun) ) RETURN

C   Get TAGRE and NTAGRE from the (NTAGI)th occurrence of TAGI.

    CALL fstag( lun, tagi, ntagi, 1, ni, iret )
    IF ( iret .NE. 0 ) RETURN
    nre = nrfelm(ni,lun)
    IF ( nre .GT. 0 ) THEN
        iret = 0
        tagre = tag(inv(nre,lun))
        CALL strsuc( tagre, tagtmp, ltre )
        ntagre = 0
        DO ii = 1, nre
        IF ( tag(inv(ii,lun))(1:ltre) .EQ. tagre(1:ltre) ) THEN
          ntagre = ntagre + 1
        END IF
        END DO
    END IF

    RETURN
    END