wrfv2_fire/frame/pack_utils.c

   1 #ifndef MS_SUA
   2 # include <stdio.h>
   3 # include <stdlib.h>
   4 #endif
   5 #include <string.h>
   6 #include "../inc/streams.h"
   7
   8 #ifndef CRAY
   9 # ifdef NOUNDERSCORE
  10 #      define INT_PACK_DATA  int_pack_data
  11 #      define INT_GET_TI_HEADER_C  int_get_ti_header_c
  12 #      define INT_GEN_TI_HEADER_C  int_gen_ti_header_c
  13 #      define ADD_TO_BUFSIZE_FOR_FIELD_C  add_to_bufsize_for_field_c
  14 #      define STORE_PIECE_OF_FIELD_C  store_piece_of_field_c
  15 #      define RETRIEVE_PIECES_OF_FIELD_C  retrieve_pieces_of_field_c
  16 #      define INIT_STORE_PIECE_OF_FIELD init_store_piece_of_field
  17 #      define INIT_RETRIEVE_PIECES_OF_FIELD init_retrieve_pieces_of_field
  18 #      define PERTURB_REAL perturb_real
  19 #      define INSPECT_HEADER inspect_header
  20 #      define RESET_MASK reset_mask
  21 #      define SET_MASK set_mask
  22 #      define GET_MASK get_mask
  23 # else
  24 #   ifdef F2CSTYLE
  25 #      define INT_PACK_DATA  int_pack_data__
  26 #      define INT_GET_TI_HEADER_C  int_get_ti_header_c__
  27 #      define INT_GEN_TI_HEADER_C  int_gen_ti_header_c__
  28 #      define ADD_TO_BUFSIZE_FOR_FIELD_C  add_to_bufsize_for_field_c__
  29 #      define STORE_PIECE_OF_FIELD_C  store_piece_of_field_c__
  30 #      define RETRIEVE_PIECES_OF_FIELD_C  retrieve_pieces_of_field_c__
  31 #      define INIT_STORE_PIECE_OF_FIELD init_store_piece_of_field__
  32 #      define INIT_RETRIEVE_PIECES_OF_FIELD init_retrieve_pieces_of_field__
  33 #      define PERTURB_REAL perturb_real__
  34 #      define INSPECT_HEADER inspect_header__
  35 #      define RESET_MASK reset_mask__
  36 #      define SET_MASK set_mask__
  37 #      define GET_MASK get_mask__
  38 #   else
  39 #      define INT_PACK_DATA  int_pack_data_
  40 #      define INT_GET_TI_HEADER_C  int_get_ti_header_c_
  41 #      define INT_GEN_TI_HEADER_C  int_gen_ti_header_c_
  42 #      define ADD_TO_BUFSIZE_FOR_FIELD_C  add_to_bufsize_for_field_c_
  43 #      define STORE_PIECE_OF_FIELD_C  store_piece_of_field_c_
  44 #      define RETRIEVE_PIECES_OF_FIELD_C  retrieve_pieces_of_field_c_
  45 #      define INIT_STORE_PIECE_OF_FIELD init_store_piece_of_field_
  46 #      define INIT_RETRIEVE_PIECES_OF_FIELD init_retrieve_pieces_of_field_
  47 #      define PERTURB_REAL perturb_real_
  48 #      define INSPECT_HEADER inspect_header_
  49 #      define RESET_MASK reset_mask_
  50 #      define SET_MASK set_mask_
  51 #      define GET_MASK get_mask_
  52 #   endif
  53 # endif
  54 #endif
  55
  56 #ifdef MEMCPY_FOR_BCOPY
  57 # define bcopy(A,B,C) memcpy((B),(A),(C))
  58 #endif
  59
  60 /*    CALL int_pack_data ( hdrbuf , hdrbufsiz * inttypesize , int_local_output_buffer, int_local_output_cursor ) */
  61
  62 INT_PACK_DATA ( unsigned char *buf , int *ninbytes , unsigned char *obuf, int *cursor )
  63 {
  64   int i, lcurs ;
  65   lcurs = *cursor - 1 ;
  66   for ( i = 0 ; i < *ninbytes ; i++ )
  67   {
  68     obuf[lcurs++] = buf[i] ;
  69   }
  70   *cursor = lcurs+1 ;
  71 }
  72
  73 int
  74 INT_GEN_TI_HEADER_C ( char * hdrbuf, int * hdrbufsize,           /* hdrbufsize is in bytes */
  75                     int * itypesize, int * typesize,
  76                     int * DataHandle, char * Data,
  77                     int * Count, int * code )
  78 {
  79   int i ;
  80   char * p ;
  81   p = hdrbuf ;
  82   p += sizeof(int) ;
  83   bcopy( code, p, sizeof(int) ) ; p += sizeof(int) ;       /* 2 */
  84   bcopy( DataHandle, p, sizeof(int) ) ; p += sizeof(int) ; /* 3 */
  85   bcopy( typesize, p, sizeof(int) ) ; p += sizeof(int) ;   /* 4 */
  86   bcopy( Count, p, sizeof(int) ) ; p += sizeof(int) ;      /* 5 */
  87   bcopy( Data, p, *Count * *typesize ) ; p += *Count * *typesize ; /* 6++ */
  88   *hdrbufsize = (int) (p - hdrbuf) ;
  89   bcopy( hdrbufsize, hdrbuf, sizeof(int) ) ;
  90   return(0) ;
  91 }
  92
  93 int
  94 INT_GET_TI_HEADER_C ( char * hdrbuf, int * hdrbufsize, int * n,  /* hdrbufsize and n are in bytes */
  95                     int * itypesize, int * typesize,
  96                     int * DataHandle, char * Data,
  97                     int * Count, int * code )
  98 {
  99   int i ;
 100   char * p ;
 101   p = hdrbuf ;
 102   bcopy( p, hdrbufsize, sizeof(int) ) ;     p += sizeof(int) ;        /* 1 */
 103   bcopy( p, code, sizeof(int) ) ;           p += sizeof(int) ;        /* 2 */
 104   bcopy( p, DataHandle, sizeof(int) ) ;     p += sizeof(int) ;        /* 3 */
 105   bcopy( p, typesize, sizeof(int) ) ;       p += sizeof(int) ;        /* 4 */
 106   bcopy( p, Count, sizeof(int) ) ;          p += sizeof(int) ;        /* 5 */
 107   if ( *Count * *typesize > 0 ) {
 108   bcopy( p, Data, *Count * *typesize ) ;  p += *Count * *typesize ; /* 6++ */
 109   }
 110   *n = (int)( p - hdrbuf ) ;
 111   return(0) ;
 112 }
 113
 114 #define MAX_FLDS 2000
 115 static char fld_name[MAX_FLDS][256] ;
 116 static char *fld_cache[MAX_FLDS] ;
 117 static int fld_curs[MAX_FLDS] ;
 118 static int fld_bufsize[MAX_FLDS] ;
 119 static int fld     = 0 ;
 120 static int numflds = 0 ;
 121 static int frst = 1 ;
 122
 123 int INIT_STORE_PIECE_OF_FIELD ()
 124 {
 125   int i ;
 126   if ( frst ) {
 127     for ( i = 0 ; i < MAX_FLDS ; i++ ) {
 128       fld_cache[i] = NULL ;
 129     }
 130     frst = 0 ;
 131   }
 132   numflds = 0 ;
 133   for ( i = 0 ; i < MAX_FLDS ; i++ ) {
 134     strcpy( fld_name[i], "" ) ;
 135     if ( fld_cache[i] != NULL ) free( fld_cache[i] ) ;
 136     fld_cache[i] = NULL ;
 137     fld_curs[i] = 0 ;
 138     fld_bufsize[i] = 0 ;
 139   }
 140   return(0) ;
 141 }
 142
 143 int INIT_RETRIEVE_PIECES_OF_FIELD ()
 144 {
 145   fld = 0 ;
 146   return(0) ;
 147 }
 148
 149 int
 150 ADD_TO_BUFSIZE_FOR_FIELD_C ( int varname[], int * chunksize )
 151 {
 152   int i, n ;
 153   int found ;
 154   char vname[256] ;
 155
 156   n = varname[0] ;
 157   for ( i = 1; i <= n ; i++ ) { vname[i-1] = varname[i] ; }
 158   vname[n] = '\0' ;
 159
 160   found = -1 ;
 161   for ( i = 0 ; i < numflds ; i++ ) { if ( !strcmp( fld_name[i], vname ) ) { found = i ; break ; } }
 162   if ( found == -1 ) {
 163     found = numflds++ ;
 164     strcpy( fld_name[found], vname ) ;
 165     fld_bufsize[found] = *chunksize ;
 166   }
 167   else
 168   {
 169     fld_bufsize[found] += *chunksize ;
 170   }
 171   if ( fld_cache[found] != NULL ) { free( fld_cache[found] ) ; }
 172   fld_cache[found] = NULL ;
 173   return(0) ;
 174 }
 175
 176 int
 177 STORE_PIECE_OF_FIELD_C ( char * buf , int varname[], int * chunksize, int *retval )
 178 {
 179   int i, n ;
 180   int found ;
 181   char vname[256] ;
 182
 183   n = varname[0] ;
 184   for ( i = 1; i <= n ; i++ ) { vname[i-1] = varname[i] ; }
 185   vname[n] = '\0' ;
 186
 187   found = -1 ;
 188   for ( i = 0 ; i < numflds ; i++ ) { if ( !strcmp( fld_name[i], vname ) ) { found = i ; break ; } }
 189   if ( found == -1 ) {
 190 #ifndef MS_SUA
 191     fprintf(stderr,"frame/pack_utils.c: field (%s) not found; was not set up with add_to_bufsize_for_field\n",vname ) ;
 192 #endif
 193     *retval = 1 ;
 194     return(0)  ;
 195   }
 196
 197   if ( fld_cache[found] == NULL ) {
 198      fld_cache[found] = (char *) malloc( fld_bufsize[found] ) ;
 199      fld_curs[found] = 0 ;
 200   }
 201
 202   if ( fld_curs[found] + *chunksize > fld_bufsize[found] ) {
 203 #ifndef MS_SUA
 204     fprintf(stderr,
 205 "frame/pack_utils.c: %s would overwrite %d + %d  > %d [%d]\n",vname, fld_curs[found], *chunksize, fld_bufsize[found], found ) ;
 206 #endif
 207     *retval = 1 ;
 208     return(0)  ;
 209   }
 210
 211   bcopy( buf, fld_cache[found]+fld_curs[found], *chunksize ) ;
 212   fld_curs[found] += *chunksize ;
 213   *retval = 0 ;
 214   return(0) ;
 215 }
 216
 217 int
 218 RETRIEVE_PIECES_OF_FIELD_C ( char * buf , int varname[], int * insize, int * outsize, int *retval )
 219 {
 220   int i, n ;
 221   int found ;
 222   char vname[256] ;
 223
 224   if ( fld < numflds ) {
 225 #ifndef MS_SUA
 226     if ( fld_curs[fld] > *insize ) {
 227       fprintf(stderr,"retrieve: fld_curs[%d] (%d) > *insize (%d)\n",fld,fld_curs[fld], *insize ) ;
 228     }
 229 #endif
 230     *outsize = ( fld_curs[fld] <= *insize ) ? fld_curs[fld] : *insize ;
 231     bcopy( fld_cache[fld], buf, *outsize ) ;
 232     varname[0] = (int) strlen( fld_name[fld] ) ;
 233     for ( i = 1 ; i <= varname[0] ; i++ ) varname[i] = fld_name[fld][i-1] ;
 234     if ( fld_cache[fld] != NULL ) free ( fld_cache[fld] ) ;
 235     fld_cache[fld] = NULL ;
 236     fld_bufsize[fld] = 0 ;
 237     fld++ ;
 238     *retval = 0 ;
 239   }
 240   else {
 241     numflds = 0 ;
 242     *retval = -1 ;
 243   }
 244   return(0) ;
 245 }
 246
 247 #define INDEX_2(A,B,NB)       ( (B) + (A)*(NB) )
 248 #define INDEX_3(A,B,C)  INDEX_2( (A), INDEX_2( (B), (C), (me[1]-ms[1]+1) ), (me[1]-ms[1]+1)*(me[0]-ms[0]+1) )
 249 /* flip low order bit of fp number */
 250 int
 251 PERTURB_REAL ( float * field, int ds[], int de[], int ms[], int me[], int ps[], int pe[] )
 252 {
 253    int i,j,k ;
 254    int le ; /* index of little end */
 255    float x = 2.0 ;
 256    unsigned int y ;
 257    unsigned char a[4], *p ;
 258    if ( sizeof(float) != 4 ) return(-1) ;
 259    /* check endianness of machine */
 260    bcopy ( &x, a, 4 ) ;
 261    le = 0 ;
 262    if ( a[0] == 0x40 ) le = 3 ;
 263    for ( k = ps[2]-ms[2] ; k <= pe[2]-ms[2] ; k++ )
 264      for ( j = ps[1]-ms[1] ; j <= pe[1]-ms[1] ; j++ )
 265        for ( i = ps[0]-ms[0] ; i <= pe[0]-ms[0] ; i++ )
 266        {
 267           /* do not change zeros */
 268           if ( field[ INDEX_3(k,j,i) ] != 0.0 ) {
 269              p = (unsigned char *)&(field[ INDEX_3(k,j,i) ] ) ;
 270              if ( *(p+le) & 1 ) { *(p+le) &= 0x7e ; }
 271              else               { *(p+le) |= 1 ; }
 272           }
 273        }
 274    return(0) ;
 275 }
 276
 277 int INSPECT_HEADER ( char * buf, int * sz, int * line )
 278 {
 279     int i ;
 280 #ifndef MS_SUA
 281     fprintf(stderr,"INSPECT_HEADER: line = %d ", *line ) ;
 282     if ( buf != NULL && sz != NULL ) {
 283       for ( i = 0 ; i < *sz && i < 256 ; i++ )  { if ( (buf[i] >= 'a' && buf[i] <= 'z') || buf[i] == '_' ||
 284                                              (buf[i] >= 'A' && buf[i] <= 'Z') ||
 285                                              (buf[i] >= '0' && buf[i] <= '9') ) fprintf(stderr,"%c",buf[i]) ;
 286                                     }
 287       fprintf(stderr,"\n") ;
 288    }
 289 #endif
 290     return(0) ;
 291 }
 292
 293 /* note that these work the same as the routines in tools/misc.c, but are Fortran callable.
 294    They must be kept in sync, functionally. */
 295
 296 void
 297 RESET_MASK ( unsigned int * mask , int *e )
 298 {
 299    int w ;
 300    unsigned int m, n ;
 301
 302    w = *e / (8*sizeof(int)-1) ;
 303    n = 1 ;
 304    m = ~( n << *e % (8*sizeof(int)-1) ) ;
 305    if ( w >= 0 && w < IO_MASK_SIZE ) {
 306      mask[w] &= m ;
 307    }
 308 }
 309
 310 void
 311 SET_MASK ( unsigned int * mask , int *e )
 312 {
 313    int w ;
 314    unsigned int m, n ;
 315
 316    w = *e / (8*sizeof(int)-1) ;
 317    n = 1 ;
 318    m = ( n << *e % (8*sizeof(int)-1) ) ;
 319    if ( w >= 0 && w < IO_MASK_SIZE ) {
 320      mask[w] |= m ;
 321    }
 322 }
 323
 324 /* this is slightly different from in tools dir since it returns result as argument, not function */
 325 /* definition of IO_MASK_SIZE comes from build and must be uniform with frame/module_domain_type.F and
 326    version of this function in tools dir */
 327 void
 328 GET_MASK ( unsigned int * mask , int *e , int * retval )
 329 {
 330    int w ;
 331    unsigned int m, n ;
 332
 333    w = *e / (8*sizeof(int)-1) ;   /* 8 is number of bits per byte */
 334    if ( w >= 0 && w < IO_MASK_SIZE ) {
 335      m = mask[w] ;
 336      n =  ( 1 << *e % (8*sizeof(int)-1) ) ;;
 337      *retval = ( (m & n) != 0 ) ;
 338    } else {
 339      *retval = 0 ;
 340    }
 341 }
 342