nemspecs.f

Go to the documentation of this file.

C> @file
C> @brief Get the scale factor, reference value and bit width
C> associated with a specified occurrence of a Table B mnemonic.
C>
C> @author J. Ator @date 2014-10-02
 
C> Given a Table B mnemonic defined within a data subset, this
C> subroutine returns the scale factor, reference value and bit
C> width of a specified occurrence of that mnemonic within the
C> overall data subset definition, counting from the beginning
C> of the subset.
C>
C> The values returned include the application of any Table C
C> operators (e.g. 2-01-YYY, 2-02-YYY, 2-03-YYY, 2-07-YYY,
C> 2-08-YYY) which may be in effect for the specified occurrence
C> of the mnemonic.
C>
C> @param[in] LUNIT  - integer: Fortran logical unit number for
C>                     BUFR file
C> @param[in] NEMO   - character*(*): Table B mnemonic
C> @param[in] NNEMO  - integer: Ordinal occurrence of NEMO for
C>                     which information is to be returned,
C>                     counting from the beginning of the overall
C>                     subset definition
C> @param[out] NSCL  - integer: Scale factor in effect for
C>                     (NNEMO)th occurrence of NEMO
C> @param[out] NREF  - integer: Reference value in effect for
C>                     (NNEMO)th occurrence of NEMO
C> @param[out] NBTS  - integer: Bit width in effect for
C>                     (NNEMO)th occurrence of NEMO
C> @param[out] IRET  - integer: return code
C>                      - 0 normal return
C>                      - -1 NEMO 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 2014-10-02
 
        RECURSIVE SUBROUTINE nemspecs
     .          ( lunit, nemo, nnemo, nscl, nref, nbts, iret )
 
        USE moda_usrint
        USE moda_msgcwd
        USE moda_tables
        USE moda_nrv203
        USE modv_im8b
 
        CHARACTER*10  tagn
 
        CHARACTER*(*) nemo
 
C----------------------------------------------------------------------
C----------------------------------------------------------------------
 
C       Check for I8 integers.
 
        IF(im8b) THEN
           im8b=.false.
 
           CALL x84(lunit,my_lunit,1)
           CALL x84(nnemo,my_nnemo,1)
           CALL nemspecs(my_lunit,nemo,my_nnemo,nscl,nref,nbts,iret)
           CALL x48(nscl,nscl,1)
           CALL x48(nref,nref,1)
           CALL x48(nbts,nbts,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       Starting from the beginning of the subset, locate the (NNEMO)th
C       occurrence of NEMO.
 
        CALL fstag( lun, nemo, nnemo, 1, nidx, ierfst )
        IF ( ierfst .NE. 0 ) RETURN
 
C       Confirm that NEMO is a Table B mnemonic.
 
        node = inv(nidx,lun)
        IF ( ( typ(node) .NE. 'NUM' ) .AND. ( typ(node) .NE. 'CHR' ) )
     .      RETURN
 
C       Get the scale factor, reference value and bit width, including
C       accounting for any Table C operators which may be in scope for
C       this particular occurrence of NEMO.
 
        iret = 0
 
        nscl = isc(node)
        nbts = ibt(node)
        nref = irf(node)
 
        IF ( nnrv .GT. 0 ) THEN
 
C         There are nodes containing redefined reference values (from
C         one or more 2-03-YYY operators) in the jump/link table, so we
C         need to check if this node is one of them.
 
          tagn = ' '
          CALL strsuc( nemo, tagn, ltn )
          IF ( ( ltn .LE. 0 ) .OR. ( ltn .GT. 8 ) ) RETURN
 
          DO jj = 1, nnrv
            IF ( ( node .NE. inodnrv(jj) ) .AND.
     .          ( tagn(1:8) .EQ. tagnrv(jj) ) .AND.
     .          ( node .GE. isnrv(jj) ) .AND.
     .          ( node .LE. ienrv(jj) ) ) THEN
              nref = int(nrv(jj))
              RETURN
            END IF
          END DO
 
        END IF
 
        RETURN
        END