ipks.f

Go to the documentation of this file.

C> @file
C> @brief Pack a real*8 value into an integer
C> by applying the proper scale and reference values.
C>
C> @author J. Ator @date 2012-03-02
 
C> This function packs a real*8 user value into a BUFR
C> 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> @param[in] VAL - real*8: user value
C> @param[in] NODE - integer: index into internal jump/link tables
C>
C> @return - integer*8: packed BUFR integer
C>
C> @remarks
C> - This function is the logical inverse of function ups().
C>
C> @author J. Ator @date 2012-03-02
        FUNCTION ipks(VAL,NODE)
 
        USE moda_tables
        USE moda_nrv203
 
        integer(8) imask, ipks
        real*8     ten,val
 
        DATA ten /10./
 
C-----------------------------------------------------------------------
 
        ipks = nint(val * ten**isc(node),8) - irf(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 should be encoded
C             as positive integers with the left-most bit set to 1.
 
              nrv(jj) = nint(val)
              IF ( nrv(jj) .LT. 0 ) THEN
                imask = 2_8**(ibt(node)-1)
                ipks = ior(abs(nrv(jj)),imask)
              ELSE
                ipks = nrv(jj)
              END IF
              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 encoding this value.
 
              ipks = nint(val * ten**isc(node),8) - nrv(jj)
              RETURN
            END IF
          END DO
 
        END IF
 
        RETURN
        END