ups.f

Go to the documentation of this file.

C> @file
C> @brief Unpack a real*8 value from an integer by applying the
C> proper scale and reference values.
C>
C> @author J. Ator @date 2012-03-02
 
C> This function unpacks a real*8 user value from a packed
C> BUFR integer by applying the proper scale and reference values.
C> Normally the scale and reference values are obtained from index
C> node of the internal jump/link table arrays isc(*) and irf(*);
C> however, the reference value in irf(*) will be overridden if a
C> 2-03 operator is in effect for this node.
C>
C> This function is the logical inverse of function ipks().
C>
C> @param[in] IVAL - integer: packed BUFR integer.
C> @param[in] NODE - integer: index into internal jump/link tables.
C> @returns UPS - real*8: user value.
C>
C> @author J. Ator @date 2012-03-02
        REAL*8 FUNCTION ups(IVAL,NODE)
 
        USE moda_tables
        USE moda_nrv203
 
        integer*8 ival,imask
        real*8    ten
 
        DATA ten /10./
 
C-----------------------------------------------------------------------
 
        ups = ( ival + irf(node) ) * ten**(-isc(node))
 
        IF ( nnrv .GT. 0 ) THEN
 
C         There are redefined reference values in the jump/link table,
C         so we need to check if this node is affected by any of them.
 
          DO jj = 1, nnrv
            IF ( node .EQ. inodnrv(jj) ) THEN
 
C             This node contains a redefined reference value.
C             Per the rules of BUFR, negative values may be encoded
C             as positive integers with the left-most bit set to 1.
 
              imask = 2_8**(ibt(node)-1)
              IF ( iand(ival,imask) .GT. 0 ) THEN
                nrv(jj) = (-1) * ( ival - imask )
              ELSE
                nrv(jj) = ival
              END IF
              ups = nrv(jj)
              RETURN
            ELSE IF ( ( tag(node)(1:8) .EQ. tagnrv(jj) ) .AND.
     .                ( node .GE. isnrv(jj) ) .AND.
     .                ( node .LE. ienrv(jj) ) ) THEN
 
C             The corresponding redefinded reference value needs to
C             be used when decoding this value.
 
              ups = ( ival + nrv(jj) ) * ten**(-isc(node))
              RETURN
            END IF
          END DO
 
        END IF
 
        RETURN
        END