File: C:\NOAA\NEMS_11731\src\chem\gocart\src\GMAO_Shared\MAPL_cfio\ShaveMantissa.c

1     
2     #include <stdio.h>
3     #include <math.h> 
4     #include "ShaveMantissa.h"   /* protype */
5     
6     #define MAXBITS 20
7     
8     #define EXPMSK 0x7f800000  //  bits set at exponent locations
9     
10     #define isZNN(E)  ((E)==0x00000000) // E=0;   zero or unnorm
11     #define isNAN(E)  ((E)==EXPMSK    ) // E=255; nan  or inf
12     
13     //#ifdef FAST_ISUNDEF
14     #if 1
15     #  define isUndef(A)  ((A) == undef) /* cheap but not robust */
16     #else
17     #  define isUndef(A)  ((float32)fabs(undef-(A))<tol) /* robust but expensive */
18     #endif
19     
20     #define SKIP(I,A)  (isZNN(I) || isUndef(A) || isNAN(I)) 
21     
22     //========================================
23     
24     float32 SetOffset(float32 minv, float32 maxv)
25     {
26       float32   midv, mnabs,  range;
27     
28       range  = (maxv-minv);
29       midv   = (maxv+minv)*0.5;
30       mnabs  = abs(maxv)>abs(minv) ? fabs(minv) : fabs(maxv);
31     
32       return (range<mnabs) ? midv : midv*(mnabs/range);
33     }
34     
35     //========================================
36     
37     /*
38     //---------------------------------------------------------------------------
39     //BOP
40     //
41     // !ROUTINE: ShaveMantissa32 - Degrades Precison of 32-bit Float Array 
42     //
43     // !INTERFACE:
44     */
45     int ShaveMantissa32 ( a, ain, len, xbits, has_undef, undef, chunksize )
46     
47     /*
48     // !INPUT PARAMETERS:
49     */
50     
51     int32   len;        /* size of a[] */
52     int     xbits;      /* number of bits to excludes from mantissa */
53     int     has_undef;  /* whether field has missing (undef) values */ 
54     int32   chunksize;  /* find mid range over chunksize chunks     */ 
55     float32 undef;      /* missing (undefined) value */
56     float32 ain[];      /* input array */
57     
58     /*
59     // !OUTPUT PARAMETERS:
60     */
61     
62     float32 a[];    // output "shaved" array; can share storage with ain[]
63     
64     /*
65     // !DESCRIPTION:  
66     //
67     //  This routine returns a lower precision version of the input array
68     //  {\tt a}, reducing the precision of the mantissa by {\tt xbits}.
69     //  (The number of bits retained is {\tt nbits = 24 - xbits}, given that
70     //  32-bit floats in IEEE representation reserves only 24 bits for the
71     //  mantissa. The purpose of this precision degradation is to promote
72     //  internal GZIP compression by HDF-4.
73     //
74     //  This algorithm produces very similar results as the standard GRIB
75     //  encoding with fixed number of bits ({\tt nbits = 24 - xbits}),
76     //  and power of 2 binary scaling.
77     //
78     // !REVISION HISTORY:
79     //
80     //  08Dec2006  Suarez    First version.
81     //  09Dec2006  da Silva  Minor revisions for IA64 build, prologue.
82     //  11Dec2006  da Silva  Merged with Max's newest version handling Inf, NAN
83     //                       and bug fixes. 
84     //  18Dec2006  Suarez    Eliminated test for overflow, which I verified was
85     //                       unnecessary. Treat zeros like undef. Eliminated a
86     //                       leftover conversion of nan to undef. Corrected macro
87     //                       for inf.  MAJOR correction to keep code from hanging
88     //                       when it encountered an invalid value.
89     //  26Dec2006  Suarez    Added selection of offset based on range and zero
90     //                       offset. Restored treatment of fields beginning with
91     //                       invalids and of all constant fields. Fixed bug that
92     //                       was not copying input to output arrays.
93     //  10Mar2009  Suarez    Used a union for the shaving. Also changed the
94     //                       SKIP  checks and protected the max and min.
95     //  24oct2009  da Silva  Changed abs() to fabs() in SetOffset; moved float32 
96     //                       defs to header so that it can be used with prototype.
97     //EOP
98     //---------------------------------------------------------------------------
99     */
100     
101     {
102       float32   maxv, minv,  offset, *b, *c, *begnxt, *last, tol;
103       uint32    round, mask, e;
104     
105       union{
106         float32 x;
107         uint32  i;
108       } aa;
109     
110       /* sanity checks */
111     
112       if ( len < 1 || xbits < 1 ) {
113         fprintf(stderr,
114     	    "ShaveMantissa32: Bad length of mask bits: len= %d, xbits= %d\n", 
115     	    len, xbits );
116         return 1;
117       }
118     
119       if ( xbits > MAXBITS ) {
120         fprintf(stderr,
121     	    "ShaveMantissa32: Shaving too many bits: %d; maximum allowed is %d\n",
122     	    xbits, MAXBITS );
123         return 2;
124       }
125     
126       /* if user has not chosen an undef, pick one */
127     
128       if ( !has_undef ) undef = (float32) HUGE_VAL;
129     
130       /* miscelaneous static combinations */
131     
132       tol   = 0.0001*undef;
133       mask  = 0xFFFFFFFF<<xbits--;
134       round = 1         <<xbits  ;
135       last  = &a[len-1];
136     
137       // Do not allow overlapping input and output buffers
138       //   unless they are the same. If not the same, copy
139       //   input to output
140     
141       b = a;
142       if(ain!=a) {
143         if(abs(ain-a)<len) {
144           fprintf(stderr,"ShaveMantissa32: Overlapping arrays");
145           return 3;
146         }
147         while(a<=last) *a++=*ain++;
148       }
149     
150       // Loop over chunks
151     
152       while(b<=last) {
153     
154         // The beginning of the chunk after the current one
155     
156         begnxt = b + chunksize;
157         if(begnxt>last) begnxt = last+1;
158     
159         // Move to first valid value in chunk and initialize min and max
160     
161         a = b-1;
162         while(++a < begnxt) {
163           aa.x = *a;
164           e    = aa.i & EXPMSK;
165           if(!SKIP(e,aa.x)) {maxv=aa.x; minv=aa.x; c=a; break;}
166         }
167     
168         // Empty chunk; go to next chunk
169     
170         if(a==begnxt) {b=begnxt; continue;}
171     
172         // Find man and max valid values of chunk
173     
174         while(++a<begnxt) {
175           aa.x = *a;
176           e    = aa.i & EXPMSK;
177           if(!SKIP(e,aa.x)) {
178     	if(aa.x<minv) minv=aa.x;
179     	if(aa.x>maxv) maxv=aa.x;
180           }
181         }
182     
183         // Constant chunk; no need to shave; go to next chunck.
184     
185         if(minv==maxv) {b=begnxt; continue;}
186     
187         // Find optimum offset
188     
189         offset = SetOffset(minv,maxv);
190     
191         // Shave chunk biginning at first valid value
192     
193         a = c-1;
194         while(++a<begnxt) {
195           aa.x = *a;
196           e    = aa.i & EXPMSK;
197           if(!SKIP(e,aa.x)) {
198     	aa.x -= offset;
199     	aa.i  = ((aa.i + round) & mask);
200     	aa.x += offset;
201     	if(aa.x>maxv) aa.x=maxv;
202     	if(aa.x<minv) aa.x=minv;
203     	*a    = aa.x;
204           }
205         }
206     
207         // Prepare for next chunk
208     
209         b = begnxt;
210     
211       } // End chunk loop
212     
213       return 0;
214     }
215     
216     //========================================
217     
218     //    Simple hook for FORTRAN interface.
219     
220     int SHAVEMANTISSA32 (float32 *a, float32 *ain, int32 *len, int *xbits, 
221                          int *has_undef, float32 *undef, int32 *chunksize)
222     {return (int)ShaveMantissa32(a,ain,*len,*xbits,*has_undef,*undef,*chunksize);}
223     
224     int SHAVEMANTISSA32_ (float32 *a, float32 *ain, int32 *len, int *xbits, 
225                           int *has_undef, float32 *undef, int32 *chunksize)
226     {return (int)ShaveMantissa32(a,ain,*len,*xbits,*has_undef,*undef,*chunksize);}
227     
228     int shavemantissa32 (float32 *a, float32 *ain, int32 *len, int *xbits, 
229                          int *has_undef, float32 *undef, int32 *chunksize)
230     {return (int)ShaveMantissa32(a,ain,*len,*xbits,*has_undef,*undef,*chunksize);}
231     
232     int shavemantissa32_ (float32 *a, float32 *ain, int32 *len, int *xbits, 
233                           int *has_undef, float32 *undef, int32 *chunksize)
234     {return (int)ShaveMantissa32(a,ain,*len,*xbits,*has_undef,*undef,*chunksize);}
235     
236     
237     
238     
239     
240