NCEPLIBS-bufr  11.7.0
 All Data Structures Files Functions Variables Pages
ups.f
Go to the documentation of this file.
1 C> @file
2 C> @author J @date 2012-03-02
3 
4 C> THIS FUNCTION UNPACKS A REAL*8 USER VALUE FROM A PACKED
5 C> BUFR INTEGER BY APPLYING THE PROPER SCALE AND REFERENCE VALUES.
6 C> NORMALLY THE SCALE AND REFERENCE VALUES ARE OBTAINED FROM INDEX
7 C> NODE OF THE INTERNAL JUMP/LINK TABLE ARRAYS ISC(*) AND IRF(*);
8 C> HOWEVER, THE REFERENCE VALUE IN IRF(*) WILL BE OVERRIDDEN IF A
9 C> 2-03 OPERATOR IS IN EFFECT FOR THIS NODE.
10 C>
11 C> PROGRAM HISTORY LOG:
12 C> 2012-03-02 J. ATOR -- ORIGINAL AUTHOR; ADAPTED FROM INTERNAL
13 C> STATEMENT FUNCTION IN OTHER SUBROUTINES
14 C> 2014-12-10 J. ATOR -- USE MODULES INSTEAD OF COMMON BLOCKS
15 C>
16 C> USAGE: UPS (IVAL,NODE)
17 C> INPUT ARGUMENT LIST:
18 C> IVAL - INTEGER: PACKED BUFR INTEGER
19 C> NODE - INTEGER: INDEX INTO INTERNAL JUMP/LINK TABLES
20 C>
21 C> OUTPUT ARGUMENT LIST:
22 C> UPS - REAL*8: USER VALUE
23 C>
24 C> REMARKS:
25 C> THIS ROUTINE CALLS: None
26 C> THIS ROUTINE IS CALLED BY: RDCMPS RDTREE UFBGET UFBTAB
27 C> UFBTAM
28 C> Normally not called by any application
29 C> programs.
30 C>
31  REAL*8 FUNCTION ups(IVAL,NODE)
32 
33  USE moda_tables
34  USE moda_nrv203
35 
36  real*8 ten
37 
38  DATA ten /10./
39 
40 C-----------------------------------------------------------------------
41 
42  ups = ( ival + irf(node) ) * ten**(-isc(node))
43 
44  IF ( nnrv .GT. 0 ) THEN
45 
46 C There are redefined reference values in the jump/link table,
47 C so we need to check if this node is affected by any of them.
48 
49  DO jj = 1, nnrv
50  IF ( node .EQ. inodnrv(jj) ) THEN
51 
52 C This node contains a redefined reference value.
53 C Per the rules of BUFR, negative values may be encoded
54 C as positive integers with the left-most bit set to 1.
55 
56  imask = 2**(ibt(node)-1)
57  IF ( iand(ival,imask) .GT. 0 ) THEN
58  nrv(jj) = (-1) * ( ival - imask )
59  ELSE
60  nrv(jj) = ival
61  END IF
62  ups = nrv(jj)
63  RETURN
64  ELSE IF ( ( tag(node)(1:8) .EQ. tagnrv(jj) ) .AND.
65  . ( node .GE. isnrv(jj) ) .AND.
66  . ( node .LE. ienrv(jj) ) ) THEN
67 
68 C The corresponding redefinded reference value needs to
69 C be used when decoding this value.
70 
71  ups = ( ival + nrv(jj) ) * ten**(-isc(node))
72  RETURN
73  END IF
74  END DO
75 
76  END IF
77 
78  RETURN
79  END
This module contains array and variable declarations for use with any 2-03-YYY (change reference valu...
Definition: moda_nrv203.F:15
This module contains array and variable declarations used to store the internal jump/link table...
Definition: moda_tables.F:13
REAL *8 function ups(IVAL, NODE)
THIS FUNCTION UNPACKS A REAL*8 USER VALUE FROM A PACKED BUFR INTEGER BY APPLYING THE PROPER SCALE AND...
Definition: ups.f:31