source: lmdz_wrf/WRFV3/external/io_grib1/MEL_grib1/gbyte.c @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 14.1 KB
Line 
1/* gbyte.c:
2  ADAPTED FROM THE ORIGINAL FORTRAN VERSION OF GBYTE BY:
3 
4              DR. ROBERT C. GAMMILL, CONSULTANT
5              NATIONAL CENTER FOR ATMOSPHERIC RESEARCH
6              MAY 1972
7 
8              CHANGES FOR FORTRAN 90
9              AUGUST 1990  RUSSELL E. JONES
10              NATIONAL WEATHER SERVICE
11              GBYTE RUN WITHOUT CHANGES ON THE FOLLOWING COMPILERS
12              MICROSOFT FORTRAN 5.0 OPTIMIZING COMPILER
13              SVS 32 386 FORTRAN 77 VERSION V2.8.1B
14              SUN FORTRAN 1.3, 1.4
15              DEC VAX FORTRAN
16              SILICONGRAPHICS 3.3, 3.4 FORTRAN 77
17              IBM370 VS COMPILER
18              INTERGRAPH GREEN HILLS FORTRAN CLIPPER 1.8.4B
19*/
20#include <stdio.h>
21#include <stdlib.h>
22
23#include "dprints.h"    /* debug prints & func prototypes */
24#include "gribfuncs.h"          /* prototypes */
25#include "isdb.h"               /* WORD_BIT_CNT defn */
26
27/* Added by Todd Hutchinson, 8/10/05*/
28/*
29 * gbyte requires the word bit count to be 32.  In order for this to work
30 *    on platforms with 8 byte longs, we must set WORD_BIT_CNT to 32 for
31 *    gbyte.
32 */
33
34#ifdef WORD_BIT_CNT
35#undef WORD_BIT_CNT
36#endif
37#define WORD_BIT_CNT 32  /* gbyte.c requires the word bit count to be 32! */
38
39/*
40*
41*****************************************************************
42* A.  FUNCTION:   gbyte
43*       extracts data of specified length from the specified offset
44*       from beginning of the given Data block.
45*
46*    INTERFACE:
47*      void   gbyte (inchar, iout, iskip, nbits)
48*
49*    ARGUMENTS (I=input, O=output, I&O=input and output):
50*      (I) char *inchar;
51*          The fullword in memory from which unpacking is to
52*          begin, successive fullwords will be fetched as required.
53*      (O) unsigned long *iout;
54*          The value read from in memory that's returned.
55*    (I&O) unsigned long  *iskip;
56*          a fullword integer specifying the inital offset
57*          in bits of the first byte, counted from the
58*          leftmost bit in Inchar.  Gets updated upon exit;
59*      (I) unsigned long nbits;
60*          a fullword integer specifying the number of bits
61*          in each byte to be unpacked.  Legal byte widths
62*          are in the range 1 - 32, bytes of width  less than 32
63*          will be right justified in the low-order positions
64*          of the unpacked fullwords with high-order zero fill.
65*
66*    RETURN CODE:  none;
67*****************************************************************
68*
69*/
70
71#if PROTOTYPE_NEEDED
72void    gbyte (char *inchar, unsigned long *iout, unsigned long *iskip,
73                unsigned long nbits)
74#else
75void gbyte (inchar, iout, iskip, nbits)
76          char *inchar;         /* input */
77          unsigned long *iout;  /* output, is the value returned */
78          unsigned long *iskip; /* input, gets updated */
79          unsigned long nbits;  /* input */
80#endif
81{
82   long masks[32];
83   long icon,index,ii,mover,movel;
84   unsigned long temp, mask, inlong;
85
86
87/*
88* A.1      INITIALIZE mask possibilities of all bits set from LSB to
89*          a particular bit position;  !bit position range: 0 to 31
90*/
91   masks[0] = 1; 
92   masks[1] = 3;
93   masks[2] = 7;
94   masks[3] = 15; 
95   masks[4] = 31;
96   masks[5] = 63;
97   masks[6] = 127;
98   masks[7] = 255;
99   masks[8] = 511;
100   masks[9] = 1023;
101   masks[10] = 2047;
102   masks[11] = 4095;
103   masks[12] = 8191;
104   masks[13] = 16383;
105   masks[14] = 32767;
106   masks[15] = 65535;
107   masks[16] = 131071;
108   masks[17] = 262143;
109   masks[18] = 524287;
110   masks[19] = 1048575; 
111   masks[20] = 2097151; 
112   masks[21] = 4194303;
113   masks[22] = 8388607; 
114   masks[23] = 16777215;
115   masks[24] = 33554431;
116   masks[25] = 67108863;
117   masks[26] = 134217727;
118   masks[27] = 268435455; 
119   masks[28] = 536870911; 
120   masks[29] = 1073741823;
121   masks[30] = 2147483647;
122   masks[31] = -1;
123
124/* NBYTE MUST BE LESS THAN OR EQUAL TO WORD_BIT_CNT
125
126*
127* A.2      IF (trying to retrieve more than numbits_perword) THEN  !here, 32
128*              RETURN
129*          ENDIF
130*/
131   icon = WORD_BIT_CNT - nbits;
132   if ( icon < 0 )
133   {
134      return;
135   }
136/*
137*
138* A.3      SET up mask needed for specified #bits to retrieve
139*/
140   mask = masks[nbits-1];
141/*
142*
143* A.4      CALCULATE Index !Byte offset from 'inchar' where retrieval begins
144*/
145   index = *iskip / WORD_BIT_CNT;
146/*
147*
148* A.5      CALCULATE Bit position within byte Index where retrieval begins
149*/
150   ii = *iskip % WORD_BIT_CNT;
151
152/*
153*
154* A.6      CALCULATE #times to Right-shift the retrieved data so it
155*          is right adjusted
156*/
157   mover = icon - ii;
158
159/*
160*
161* A.7.a    IF (need to right-adjust the byte) THEN
162*/
163   if ( mover > 0 )
164   {
165
166/*
167* A.7.a.1     RETRIEVE 4 continuous byte from offset Index in block
168*/
169     {
170       unsigned long l0, l1, l2, l3;
171       l0 = (unsigned long)inchar[index*4] << 24;
172       l1 = (unsigned long)(0x000000FF & inchar[index*4+1 ]) << 16;
173       l2 = (unsigned long)(0x000000FF & inchar[index*4+2 ]) << 8;
174       l3 = (unsigned long)(0x000000FF & inchar[index*4+3 ]);
175       inlong = l0 + l1 + l2 + l3;
176     }
177/*
178* A.7.a.2     RIGHT adjust this value
179*/
180     *iout = inlong >> mover;
181/*
182* A.7.a.3     MASK out the bits wanted only    !result in *out
183*/
184     *iout = (*iout & mask);
185   } /* If */
186
187
188/*
189* A.7.b    ELSE IF (byte is split across a word break) THEN
190*/
191   else if ( mover < 0 )
192   {
193/*
194*             !
195*             !Get the valid bits out of the FIRST WORD
196*             !
197* A.7.b.1     CALCULATE #times to move retrieve data left so
198*             the 1st significant bit aligns with MSB of word
199* A.7.b.2     CALCULATE #times to move data that's aligned
200*             with MSB so that it aligns with LSB of word
201*/
202      movel = -mover;
203      mover = WORD_BIT_CNT - movel;   /* WORD_BIT_CNT is 32 */
204
205/*
206* A.7.b.3     RETRIEVE 4-byte word from offset Index from block
207*/
208     {
209       unsigned long l0, l1, l2, l3;
210       l0 = (unsigned long)(0x000000FF & inchar[index*4]) << 24;
211       l1 = (unsigned long)(0x000000FF & inchar[index*4+1 ]) << 16;
212       l2 = (unsigned long)(0x000000FF & inchar[index*4+2 ]) << 8;
213       l3 = (unsigned long)(0x000000FF & inchar[index*4+3 ]);
214       inlong = l0 + l1 + l2 + l3;
215     }
216/*
217* A.7.b.4     SHIFT retrieve this data all the way left !Left portion
218*/
219
220/*
221*             !
222*             !Now Get the valid bits out of the SECOND WORD
223*             !
224* A.7.b.5     RETRIEVE the next 4-byte word from block
225*/
226      *iout = inlong << movel;
227     {
228       unsigned long l0, l1, l2, l3;
229       l0 = (unsigned long)(0x000000FF & inchar[index*4+4]) << 24;
230       l1 = (unsigned long)(0x000000FF & inchar[index*4+5 ]) << 16;
231       l2 = (unsigned long)(0x000000FF & inchar[index*4+6 ]) << 8;
232       l3 = (unsigned long)(0x000000FF & inchar[index*4+7 ]);
233       inlong = l0 + l1 + l2 + l3;
234     }
235/*
236* A.7.b.6     SHIFT this data all the way right   !Right portion
237* A.7.b.7     OR the Left portion and Right portion together
238* A.7.b.8     MASK out the #bits wanted only     !result in *iout
239*/
240      temp  = inlong >> mover;
241      *iout = *iout|temp;
242      *iout &= mask;
243/*
244  THE BYTE IS ALREADY RIGHT ADJUSTED.
245*/
246   }
247   else
248/*
249* A.7.c    ELSE    !the byte is already adjusted, no shifts needed
250*/
251   {
252/*
253* A.7.c.1     RETRIEVE the next 4-byte word from block
254*/
255     {
256       unsigned long l0, l1, l2, l3;
257       l0 = (unsigned long)(0x000000FF & inchar[index*4]) << 24;
258       l1 = (unsigned long)(0x000000FF & inchar[index*4+1 ]) << 16;
259       l2 = (unsigned long)(0x000000FF & inchar[index*4+2 ]) << 8;
260       l3 = (unsigned long)(0x000000FF & inchar[index*4+3 ]);
261       inlong = l0 + l1 + l2 + l3;
262     }
263/*
264* A.7.c.2     MASK out the bits wanted only    !result in *out
265*/
266      *iout = inlong&mask;
267   }
268/*
269* A.7.c    ENDIF    !the byte is already adjusted
270*/
271
272/*
273*
274* A.8      DEBUG printing
275*/
276  DPRINT3 ("gbyte(skip=%d %d bits)= %lu stored as ", *iskip, nbits, *iout);
277/*
278*
279* A.9      BUMP pointer up
280*/
281        *iskip += nbits;
282/*
283* END OF FUNCTION
284*
285*
286*/
287}
288
289/*
290*
291*****************************************************************
292* B.  FUNCTION:   gbyte_quiet
293*       called to extract data of specified length from
294*       specified offset from a block of type char; 
295*       Identical to gbyte() except it does not print out in debug mode;
296*
297*    INTERFACE:
298*      void gbyte_quiet (inchar, iout, iskip, nbits)
299*
300*    ARGUMENTS (I=input, O=output, I&O=input and output):
301*      (I) char *inchar
302*          The fullword in memory from which unpacking is to
303*          begin, successive fullwords will be fetched as required.
304*      (O) unsigned long *iout
305*          The value read from memory that's being returned.
306*    (I&O) unsigned long  *iskip
307*          a fullword integer specifying the inital offset
308*          in bits of the first byte, counted from the
309*          leftmost bit in Inchar.  Gets updated upon exit;
310*      (I) unsigned long nbits
311*          a fullword integer specifying the number of bits
312*          in each byte to be unpacked.  Legal byte widths
313*          are in the range 1 - 32, bytes of width  less than 32
314*          will be right justified in the low-order positions
315*          of the unpacked fullwords with high-order zero fill.
316*
317*    RETURN CODE:  none;
318*****************************************************************
319*
320*/
321
322#if PROTOTYPE_NEEDED
323void gbyte_quiet (char *inchar, unsigned long *iout, unsigned long *iskip,
324                unsigned long nbits)
325#else
326void gbyte_quiet (inchar, iout, iskip, nbits)
327          char *inchar;         /* input */
328          unsigned long *iout;  /* output, is the value returned */
329          unsigned long *iskip; /* input, gets updated */
330          unsigned long nbits;  /* input */
331
332#endif
333{
334   long masks[32];
335   long icon,index,ii,mover,movel;
336   unsigned long temp, mask, inlong;
337
338
339/*
340* B.1      INITIALIZE mask possibilities of all bits set from LSB to
341*          a particular bit position;  !bit position range: 0 to 31
342*/
343   masks[0] = 1; 
344   masks[1] = 3;
345   masks[2] = 7;
346   masks[3] = 15; 
347   masks[4] = 31;
348   masks[5] = 63;
349   masks[6] = 127;
350   masks[7] = 255;
351   masks[8] = 511;
352   masks[9] = 1023;
353   masks[10] = 2047;
354   masks[11] = 4095;
355   masks[12] = 8191;
356   masks[13] = 16383;
357   masks[14] = 32767;
358   masks[15] = 65535;
359   masks[16] = 131071;
360   masks[17] = 262143;
361   masks[18] = 524287;
362   masks[19] = 1048575; 
363   masks[20] = 2097151; 
364   masks[21] = 4194303;
365   masks[22] = 8388607; 
366   masks[23] = 16777215;
367   masks[24] = 33554431;
368   masks[25] = 67108863;
369   masks[26] = 134217727;
370   masks[27] = 268435455; 
371   masks[28] = 536870911; 
372   masks[29] = 1073741823;
373   masks[30] = 2147483647;
374   masks[31] = -1;
375
376/* NBYTE MUST BE LESS THAN OR EQUAL TO WORD_BIT_CNT
377
378*
379* B.2      IF (trying to retrieve more than numbits_perword) THEN  !here, 32
380*              RETURN
381*          ENDIF
382*/
383   icon = WORD_BIT_CNT - nbits;
384   if ( icon < 0 )
385   {
386      return;
387   }
388/*
389*
390* B.3      SET up mask needed for specified #bits to retrieve
391*/
392   mask = masks[nbits-1];
393/*
394*
395* B.4      CALCULATE Index !Byte offset from 'inchar' where retrieval begins
396*/
397   index = *iskip / WORD_BIT_CNT;
398/*
399*
400* B.5      CALCULATE Bit position within byte Index where retrieval begins
401*/
402   ii = *iskip % WORD_BIT_CNT;
403
404/*
405*
406* B.6      CALCULATE #times to Right-shift the retrieved data so it
407*          is right adjusted
408*/
409   mover = icon - ii;
410
411/*
412*
413* B.7.a    IF (need to right-adjust the byte) THEN
414*/
415   if ( mover > 0 )
416   {
417
418/*
419* B.7.a.1     RETRIEVE 4 continuous byte from offset Index in block
420*/
421     {
422       unsigned long l0, l1, l2, l3;
423       l0 = (unsigned long)inchar[index*4] << 24;
424       l1 = (unsigned long)(0x000000FF & inchar[index*4+1 ]) << 16;
425       l2 = (unsigned long)(0x000000FF & inchar[index*4+2 ]) << 8;
426       l3 = (unsigned long)(0x000000FF & inchar[index*4+3 ]);
427       inlong = l0 + l1 + l2 + l3;
428     }
429/*
430* B.7.a.2     RIGHT adjust this value
431*/
432     *iout = inlong >> mover;
433/*
434* B.7.a.3     MASK out the bits wanted only    !result in *out
435*/
436     *iout = (*iout & mask);
437   } /* If */
438
439
440/*
441* B.7.b    ELSE IF (byte is split across a word break) THEN
442*/
443   else if ( mover < 0 )
444   {
445/*
446*             !
447*             !Get the valid bits out of the FIRST WORD
448*             !
449* B.7.b.1     CALCULATE #times to move retrieve data left so
450*             the 1st significant bit aligns with MSB of word
451* B.7.b.2     CALCULATE #times to move data that's aligned
452*             with MSB so that it aligns with LSB of word
453*/
454      movel = -mover;
455      mover = WORD_BIT_CNT - movel;   /* WORD_BIT_CNT is 32 */
456
457/*
458* B.7.b.3     RETRIEVE 4-byte word from offset Index from block
459*/
460     {
461       unsigned long l0, l1, l2, l3;
462       l0 = (unsigned long)(0x000000FF & inchar[index*4]) << 24;
463       l1 = (unsigned long)(0x000000FF & inchar[index*4+1 ]) << 16;
464       l2 = (unsigned long)(0x000000FF & inchar[index*4+2 ]) << 8;
465       l3 = (unsigned long)(0x000000FF & inchar[index*4+3 ]);
466       inlong = l0 + l1 + l2 + l3;
467     }
468/*
469* B.7.b.4     SHIFT retrieve this data all the way left !Left portion
470*/
471
472/*
473*             !
474*             !Now Get the valid bits out of the SECOND WORD
475*             !
476* B.7.b.5     RETRIEVE the next 4-byte word from block
477*/
478      *iout = inlong << movel;
479     {
480       unsigned long l0, l1, l2, l3;
481       l0 = (unsigned long)(0x000000FF & inchar[index*4+4]) << 24;
482       l1 = (unsigned long)(0x000000FF & inchar[index*4+5 ]) << 16;
483       l2 = (unsigned long)(0x000000FF & inchar[index*4+6 ]) << 8;
484       l3 = (unsigned long)(0x000000FF & inchar[index*4+7 ]);
485       inlong = l0 + l1 + l2 + l3;
486     }
487/*
488* B.7.b.6     SHIFT this data all the way right   !Right portion
489* B.7.b.7     OR the Left portion and Right portion together
490* B.7.b.8     MASK out the #bits wanted only     !result in *iout
491*/
492      temp  = inlong >> mover;
493      *iout = *iout|temp;
494      *iout &= mask;
495/*
496  THE BYTE IS ALREADY RIGHT ADJUSTED.
497*/
498   }
499   else
500/*
501* B.7.c    ELSE    !the byte is already adjusted, no shifts needed
502*/
503   {
504/*
505* B.7.c.1     RETRIEVE the next 4-byte word from block
506*/
507     {
508       unsigned long l0, l1, l2, l3;
509       l0 = (unsigned long)(0x000000FF & inchar[index*4]) << 24;
510       l1 = (unsigned long)(0x000000FF & inchar[index*4+1 ]) << 16;
511       l2 = (unsigned long)(0x000000FF & inchar[index*4+2 ]) << 8;
512       l3 = (unsigned long)(0x000000FF & inchar[index*4+3 ]);
513       inlong = l0 + l1 + l2 + l3;
514     }
515/*
516* B.7.c.2     MASK out the bits wanted only    !result in *out
517*/
518      *iout = inlong&mask;
519   }
520/*
521* B.7.c    ENDIF    !the byte is already adjusted
522*/
523
524/*
525*
526* B.8      BUMP pointer up
527*/
528        *iskip += nbits;
529/*
530* END OF FUNCTION
531*
532*/
533}
Note: See TracBrowser for help on using the repository browser.