gettagpr.f

Go to the documentation of this file.

C> @file
C> @brief Get the parent for a specified occurrence of a Table B or
C> Table D mnemonic.
C>
C> @author J. Ator @date 2012-09-12
 
C> This subroutine returns the Table D mnemonic corresponding to the
C> parent sequence of a specified Table B or Table D mnemonic within
C> a data subset definition.
C>
C> @param[in] LUNIT  -- integer: Fortran logical unit number for
C>                      BUFR file
C> @param[in] TAGCH  -- character*(*): Table B or Table D mnemonic
C> @param[in] NTAGCH -- integer: Ordinal occurrence of TAGCH for
C>                      which the parent Table D mnemonic is to be
C>                      returned, counting from the beginning of the
C>                      overall subset definition
C> @param[out] TAGPR -- character*(*): Table D mnemonic corresponding
C>                      to parent sequence of (NTAGCH)th occurrence
C>                      of TAGCH
C> @param[out] IRET  -- integer: return code
C>                      - 0 = normal return
C>                      - -1 = TAGPR 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 2012-09-12
        RECURSIVE SUBROUTINE gettagpr
     .          ( lunit, tagch, ntagch, tagpr, iret )
 
        USE moda_usrint
        USE moda_msgcwd
        USE moda_tables
        USE modv_im8b
 
        CHARACTER*(*) tagch, tagpr
 
C----------------------------------------------------------------------
C----------------------------------------------------------------------
 
C       Check for I8 integers.
 
        IF(im8b) THEN
           im8b=.false.
 
           CALL x84 ( lunit, my_lunit, 1 )
           CALL x84 ( ntagch, my_ntagch, 1 )
           CALL gettagpr ( my_lunit, tagch, my_ntagch, tagpr, iret )
           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 TAGPR from the (NTAGCH)th occurrence of TAGCH.
 
        CALL fstag( lun, tagch, ntagch, 1, nch, iret )
        IF ( iret .NE. 0 ) RETURN
 
        tagpr = tag(jmpb(inv(nch,lun)))
 
        RETURN
        END