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>
C> @author J. Ator @date 2016-06-07
 
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> @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> 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> @author J. Ator @date 2016-06-07
        RECURSIVE SUBROUTINE gettagre
     .          ( lunit, tagi, ntagi, tagre, ntagre, iret )
 
        USE moda_usrint
        USE moda_msgcwd
        USE moda_tables
        USE modv_im8b
 
        CHARACTER*(*) tagi, tagre
 
        CHARACTER*10 tagtmp
 
C----------------------------------------------------------------------
C----------------------------------------------------------------------
 
C       Check for I8 integers.
 
        IF(im8b) THEN
           im8b=.false.
 
           CALL x84(lunit,my_lunit,1)
           CALL x84(ntagi,my_ntagi,1)
           CALL gettagre(my_lunit,tagi,my_ntagi,tagre,ntagre,iret)
           CALL x48(ntagre,ntagre,1)
           CALL x48(iret,iret,1)
 
           im8b=.true.
           RETURN
        ENDIF
 
        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