external/io_grib1/MEL_grib1/gbyte.c

   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
  72 void    gbyte (char *inchar, unsigned long *iout, unsigned long *iskip,
  73                 unsigned long nbits)
  74 #else
  75 void 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
 323 void gbyte_quiet (char *inchar, unsigned long *iout, unsigned long *iskip,
 324                 unsigned long nbits)
 325 #else
 326 void 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 }