NCEPLIBS-bufr  11.5.0
 All Data Structures Files Functions Variables Pages
ipks.f
Go to the documentation of this file.
1 C> @file
2 C> @author J @date 2012-03-02
3 
4 C> THIS FUNCTION PACKS A REAL*8 USER VALUE INTO A BUFR
5 C> 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 WRTREE
14 C> 2014-12-10 J. ATOR -- USE MODULES INSTEAD OF COMMON BLOCKS
15 C>
16 C> USAGE: IPKS (VAL,NODE)
17 C> INPUT ARGUMENT LIST:
18 C> VAL - REAL*8: USER VALUE
19 C> NODE - INTEGER: INDEX INTO INTERNAL JUMP/LINK TABLES
20 C>
21 C> OUTPUT ARGUMENT LIST:
22 C> IPKS - INTEGER: PACKED BUFR VALUE
23 C>
24 C> REMARKS:
25 C> THIS ROUTINE CALLS: None
26 C> THIS ROUTINE IS CALLED BY: WRTREE
27 C> Normally not called by any application
28 C> programs.
29 C>
30  INTEGER FUNCTION ipks(VAL,NODE)
31 
32  USE moda_tables
33  USE moda_nrv203
34 
35  real*8 ten,val
36 
37  DATA ten /10./
38 
39 C-----------------------------------------------------------------------
40 
41  ipks = nint( val * ten**(isc(node)) ) - irf(node)
42 
43  IF ( nnrv .GT. 0 ) THEN
44 
45 C There are redefined reference values in the jump/link table,
46 C so we need to check if this node is affected by any of them.
47 
48  DO jj = 1, nnrv
49  IF ( node .EQ. inodnrv(jj) ) THEN
50 
51 C This node contains a redefined reference value.
52 C Per the rules of BUFR, negative values should be encoded
53 C as positive integers with the left-most bit set to 1.
54 
55  nrv(jj) = nint(val)
56  IF ( nrv(jj) .LT. 0 ) THEN
57  imask = 2**(ibt(node)-1)
58  ipks = ior(iabs(nrv(jj)),imask)
59  ELSE
60  ipks = nrv(jj)
61  END IF
62  RETURN
63  ELSE IF ( ( tag(node)(1:8) .EQ. tagnrv(jj) ) .AND.
64  . ( node .GE. isnrv(jj) ) .AND.
65  . ( node .LE. ienrv(jj) ) ) THEN
66 
67 C The corresponding redefinded reference value needs to
68 C be used when encoding this value.
69 
70  ipks = nint( val * ten**(isc(node)) ) - nrv(jj)
71  RETURN
72  END IF
73  END DO
74 
75  END IF
76 
77  RETURN
78  END
This module contains array and variable declarations for use with any 2-03-YYY (change reference valu...
Definition: moda_nrv203.F:15
INTEGER function ipks(VAL, NODE)
THIS FUNCTION PACKS A REAL*8 USER VALUE INTO A BUFR INTEGER BY APPLYING THE PROPER SCALE AND REFERENC...
Definition: ipks.f:30
This module contains array and variable declarations used to store the internal jump/link table...
Definition: moda_tables.F:13