int pp_swapbytes(void *ptr, int bytes, int nchunk) { int i; char *p; char t; p = (char*) ptr; /* just deal with the 2 realistic cases; faster than * doing the general case with two sliding pointers */ switch(bytes){ case 4: for(i=0; i<nchunk; i++){ t=p[3]; p[3]=p[0]; p[0]=t; t=p[2]; p[2]=p[1]; p[1]=t; p+=4; } break; case 8: for(i=0; i<nchunk; i++){ t=p[7]; p[7]=p[0]; p[0]=t; t=p[6]; p[6]=p[1]; p[1]=t; t=p[5]; p[5]=p[2]; p[2]=t; t=p[4]; p[4]=p[3]; p[3]=t; p+=8; } break; default: pp_switch_bug("pp_swap_bytes"); ERR; } return 0; ERRBLKI("pp_swapbytes"); }
int pp_extra_has_vector(const PPextravec extra, const PPrec *rec, const PPfile *ppfile) { /* JAK comment ERROR returns could be better ?*/ const PPhdr *hdrp; FILE *fh; int pack; int nread; size_t pos, epos; char *errmess; Fint ic, ia, ib; errmess=""; CKP(ppfile); CKP(rec); hdrp=&(rec->hdr); fh = ppfile->fh; pack = pp_get_var_packing(hdrp); if (pack==0) { pos=rec->datapos+(hdrp->LBROW*hdrp->LBNPT)*ppfile->wordsize; epos=pos+hdrp->LBEXT*ppfile->wordsize; ia=1; while (pos < epos && ia > 0) { fseek(fh, pos, SEEK_SET); if ((nread=pp_read_words(&ic, 1, convert_int, ppfile)) != 1) ERR; ia=ic/1000; ib=ic-ia*1000; if (ib == extra) { switch (extra) { case extra_x: if (ia != hdrp->LBNPT) { errmess="mismatch between pp header and extra data sections. Corrupt input file?"; ERR; } break; case extra_y: if (ia != hdrp->LBROW) { errmess="mismatch between pp header and extra data sections. Corrupt input file?"; ERR; } break; case extra_title: ; default: pp_switch_bug("pp_has_extra_vector"); } return 1; /* found the axis we are after */ } pos+=ia; } return 0; } else { errmess="only do unpacked exta data"; ERR; } err: pp_error_mesg("pp_extra_has_vector",errmess); return 0; }
PPcalendartype pp_calendar_type(Fint type) { switch(type%10) { case 0: /* fallthrough */ case 3: return model; break; /* notreached */ case 1: return gregorian; break; /* notreached */ case 2: return cal360day; break; /* notreached */ default: pp_switch_bug("pp_calendar_type"); ERR; } /* on error return -1 (though only useful to calling routine if stored in an int * not a PPcalendartype) */ ERRBLKI("pp_calendar_type"); }
Freal pp_time_diff(Fint LBTIM, const PPdate *date, const PPdate *orig_date) { long long secs; switch(pp_calendar_type(LBTIM)) { case gregorian: return pp_sec_to_day(pp_gregorian_to_secs(date) - pp_gregorian_to_secs(orig_date)); break; /* notreached */ case cal360day: secs = date->second - orig_date->second + 60 * (date->minute - orig_date->minute + 60 * (date->hour - orig_date->hour + 24 * (date->day - orig_date->day + 30 * (date->month - orig_date->month + 12 * (long long) (date->year - orig_date->year) )))); return pp_sec_to_day(secs); break; /* notreached */ case model: secs = date->second - orig_date->second + 60 * (date->minute - orig_date->minute + 60 * (date->hour - orig_date->hour + 24 * (long long) (date->day - orig_date->day))); return pp_sec_to_day(secs); break; /* notreached */ default: pp_switch_bug("pp_time_diff"); ERR; } ERRBLKF("pp_time_diff"); }
/* * Routine to add dimensions and associated coordinate variables * to cudims and cuvars. * Also updates numbers of dims and vars */ int pp_add_dims_and_coord_vars( PPlist *xaxes, PPlist *yaxes, PPlist *zaxes, PPlist *taxes, int tmdimid, CuDim *cudims, CuVar *cuvars, int *ndimsp, int *nvarsp, PPlist *heaplist) { PPlist *axislist; PPaxistype axistype; int idim; /* dim number of given type */ int dimid; int varid; PPlisthandle handle; PPgenaxis *axis; /*JAK 2005-01-10 */ CuDim *dim; CuVar *var; /* PPdim *ppdim; */ PPvar *ppvar; char dimnamestem[CU_MAX_NAME], units[CU_MAX_NAME]; char *varnamea, *varnameb; char formulaterms[MAX_ATT_LEN+1]; PPlist *catts; varid = *nvarsp; dimid = *ndimsp; for (axistype = 0; axistype < num_axistype; axistype++) { switch(axistype){ case xaxistype: axislist = xaxes; break; case yaxistype: axislist = yaxes; break; case zaxistype: axislist = zaxes; break; case taxistype: axislist = taxes; break; default: pp_switch_bug("cdunifpp_process"); } pp_list_startwalk(axislist, &handle); idim = 0; while ((axis = pp_list_walk(&handle, 0)) != NULL) { dim = &cudims[dimid]; var = &cuvars[varid]; /* ppdim = (PPdim*) dim->internp; */ ppvar = (PPvar*) var->internp; dim->coord = var; axis->dimid = dimid; dim->len = pp_genaxis_len(axis); CKP( ppvar->data = pp_genaxis_getCF(axis, dimnamestem, units, ppvar->atts, heaplist) ); sprintf(dim->name, dimnamestem, idim); if (units != NULL) { strncpy(dim->units, units, CU_MAX_NAME); dim->units[CU_MAX_NAME] = '\0'; } strncpy(var->name, dim->name, CU_MAX_NAME); var->name[CU_MAX_NAME] = '\0'; var->ndims = 1; var->dims[0] = dimid; varid++; /* now add certain variables for hybrid_sigmap z axis */ if (axistype == zaxistype && pp_zaxis_lev_type(axis) == hybrid_sigmap_lev_type) { catts = ppvar->atts; /* attribute list for the main coord var */ /* Hybrid sigma-p A coefficient */ var = &cuvars[varid]; ppvar = (PPvar*) var->internp; sprintf(var->name, "z%d_hybrid_sigmap_acoeff", idim); varnamea = var->name; CKP( ppvar->data = pp_genaxis_to_values(axis, hybrid_sigmap_a_type, heaplist) ); CKI( pp_add_string_att(ppvar->atts, "units", "Pa", heaplist) ); CKI( pp_add_string_att(ppvar->atts, "long_name", "atmospheric hybrid sigma-pressure 'A' coefficient", heaplist) ); var->ndims = 1; var->dims[0] = dimid; varid++; /* Hybrid sigma-p B coefficient */ var = &cuvars[varid]; ppvar = (PPvar*) var->internp; sprintf(var->name, "z%d_hybrid_sigmap_bcoeff", idim); varnameb = var->name; CKP( ppvar->data = pp_genaxis_to_values(axis, hybrid_sigmap_b_type, heaplist) ); CKI( pp_add_string_att(ppvar->atts, "long_name", "atmospheric hybrid sigma-pressure 'B' coefficient", heaplist) ); var->ndims = 1; var->dims[0] = dimid; varid++; snprintf(formulaterms, MAX_ATT_LEN, "ap: %s b: %s ps: ps p0: p0", varnamea, varnameb); CKI( pp_add_string_att(catts, "formula_terms", formulaterms, heaplist) ); CKI( pp_add_string_att(catts, "standard_name", "atmosphere_hybrid_sigma_pressure_coordinate", heaplist) ); CKI( pp_add_string_att(catts, "comments", "The \"ps\" term in formula_terms is set to \"ps\" variable. " "This variable may or may not be provided.", heaplist) ); } /* now add certain variables for hybrid_height z axis */ if (axistype == zaxistype && pp_zaxis_lev_type(axis) == hybrid_height_lev_type) { catts = ppvar->atts; /* attribute list for the main coord var */ /* Hybrid height A coefficient */ var = &cuvars[varid]; ppvar = (PPvar*) var->internp; sprintf(var->name, "z%d_hybrid_height_acoeff", idim); varnamea = var->name; CKP( ppvar->data = pp_genaxis_to_values(axis, hybrid_height_a_type, heaplist) ); CKI( pp_add_string_att(ppvar->atts, "units", "m", heaplist) ); var->ndims = 1; var->dims[0] = dimid; varid++; /* Hybrid height B coefficient */ var = &cuvars[varid]; ppvar = (PPvar*) var->internp; sprintf(var->name, "z%d_hybrid_height_bcoeff", idim); varnameb = var->name; CKP( ppvar->data = pp_genaxis_to_values(axis, hybrid_height_b_type, heaplist) ); var->ndims = 1; var->dims[0] = dimid; varid++; snprintf(formulaterms, MAX_ATT_LEN, "a: %s b: %s orog: orography", varnamea, varnameb); CKI( pp_add_string_att(catts, "formula_terms", formulaterms, heaplist) ); CKI( pp_add_string_att(catts, "standard_name", "atmosphere_hybrid_sigma_pressure_coordinate", heaplist) ); CKI( pp_add_string_att(catts, "comments", "The \"orog\" term in formula_terms is set to \"orography\" variable. " "This variable may or may not be provided.", heaplist) ); } /* add the boundary variable for time mean */ if (axistype == taxistype && pp_taxis_is_time_mean(axis)) { catts = ppvar->atts; /* attribute list for the main coord var */ var = &cuvars[varid]; ppvar = (PPvar*) var->internp; sprintf(var->name, "time_bnd%d", idim); CKP( ppvar->data = pp_taxis_to_boundary_values(axis->axis, heaplist) ); var->ndims = 2; var->dims[0] = dimid; var->dims[1] = tmdimid; CKI( pp_add_string_att(catts, "bounds", var->name, heaplist) ); varid++; } dimid++; idim++; } /* end loop over axes of given */ } /* end loop over axis types */ *nvarsp = varid; *ndimsp = dimid; return 0; ERRBLKI("pp_add_dims_and_coord_vars"); }
size_t pp_evaluate_lengths (const PPhdr *hdrp, const PPfile *ppfile, size_t *datalenp, size_t *disklenp) { size_t datalen; size_t disklen; if (hdrp->LBPACK != 0) { datalen=0; if (hdrp->LBROW > 0 && hdrp->LBNPT>0) datalen += hdrp->LBROW * hdrp->LBNPT; if (hdrp->LBEXT > 0) datalen += hdrp->LBEXT; if (datalen==0) datalen = hdrp->LBLREC; /* Input array size (packed field): * First try LBNREC * then if Cray 32-bit packing, know ratio of packed to unpacked lengths; * else use LBLREC * * For raw PP files, first try LBLREC if it's non-zero, because values of * LBNREC written by CONVPP may be wrong (particularly if CONVPP does unpacking) */ switch(ppfile->type) { case um_type: disklen = (hdrp->LBNREC != 0) ? hdrp->LBNREC : (hdrp->LBPACK%10 ==2) ? datalen * 4 / ppfile->wordsize : hdrp->LBLREC; break; case pp_type: disklen = (hdrp->LBLREC != 0) ? hdrp->LBLREC : (hdrp->LBNREC != 0) ? hdrp->LBNREC : (hdrp->LBPACK%10 ==2) ? datalen * 4 / ppfile->wordsize : 0; break; default: pp_switch_bug("pp_evaluate_lengths"); ERR; } } else { disklen=0; /* init to avoid compiler warnings */ /* unpacked record */ datalen = hdrp->LBLREC; /* UM file: try LBNREC first * * PP file: try LBLREC first, because convpp copies LBNREC direct from UM file * without setting it to value appropriate to PP file */ switch(ppfile->type) { case pp_type: disklen = (hdrp->LBLREC != 0) ? hdrp->LBLREC : hdrp->LBNREC; break; case um_type: disklen = (hdrp->LBNREC != 0) ? hdrp->LBNREC : hdrp->LBLREC; break; default: pp_switch_bug("pp_evaluate_lengths"); ERR; } } if (datalenp != NULL) *datalenp = datalen; if (disklenp != NULL) *disklenp = disklen; return 0; ERRBLKI("pp_evaluate_lengths"); }
int pp_read_all_headers(CuFile *file) { FILE *fh; int rec, nrec, recsize, filerec, nlrec; void *hdr; PPfile *ppfile; PPrec **recs,*recp; PPlist *heaplist; Fint start_lookup, nlookup1, nlookup2, lbbegin, dataset_type, start_data; size_t hdr_start, hdr_size, lbbegin_offset, datapos; int *valid; PPhdr *hdrp; int fieldsfile; ppfile=file->internp; fh=ppfile->fh; heaplist=ppfile->heaplist; switch(ppfile->type) { case pp_type: fseek(fh,0,SEEK_SET); /* count the PP records in the file */ for (nrec=0; (recsize=pp_skip_fortran_record(ppfile)) != -1; nrec++) { ERRIF(recsize==-2); if (recsize != n_hdr * ppfile->wordsize) { CuError(CU_EOPEN,"Opening PP file %s: unsupported header length: %d words", file->controlpath, recsize / ppfile->wordsize); ERR; } ERRIF( pp_skip_fortran_record(ppfile) <0); /* skip the data record */ } /* now rewind, and read in all the PP header data */ fseek(fh,0,SEEK_SET); ppfile->nrec=nrec; CKP( recs=pp_malloc(nrec*sizeof(PPrec*),heaplist) ); ppfile->recs = recs; for (rec=0; rec<nrec; rec++){ /* fill in the record information - for each record, read the header * record into heap memory, copy out of it the elements we want to store * then free the heap memory. */ /* just skip the fortran integers - we've already tested header length */ CKI( pp_skip_word(ppfile) ); CKP( hdr=pp_read_header(ppfile,heaplist) ); CKI( pp_skip_word(ppfile) ); CKP( recp=pp_malloc(sizeof(PPrec),heaplist) ); recs[rec]=recp; hdrp=&recp->hdr; pp_store_header(hdrp, hdr); if (ppfile->store_raw_headers) { CKI( pp_store_raw_header(hdrp, hdr, heaplist) ); } else { hdrp->rawhdr = NULL; } recp->recno = rec; /* skip data record but store length */ recp->datapos = ftell(fh) + ppfile->wordsize; recp->disklen = pp_skip_fortran_record(ppfile) / ppfile->wordsize; /* work out datalen */ pp_evaluate_lengths(hdrp, ppfile, &recp->datalen, NULL); CKI( pp_free(hdr,heaplist) ); } break; case um_type: /* pick out certain information from the fixed length header */ CKI( fseek(fh,4*ppfile->wordsize,SEEK_SET) ); ERRIF( pp_read_words(&dataset_type, 1, convert_int, ppfile) !=1); CKI( fseek(fh,149*ppfile->wordsize,SEEK_SET) ); ERRIF( pp_read_words(&start_lookup, 1, convert_int, ppfile) !=1); ERRIF( pp_read_words(&nlookup1, 1, convert_int, ppfile) !=1); ERRIF( pp_read_words(&nlookup2, 1, convert_int, ppfile) !=1); CKI( fseek(fh,159*ppfile->wordsize,SEEK_SET) ); ERRIF( pp_read_words(&start_data, 1, convert_int, ppfile) !=1); /* fieldsfiles includes ancillary files and initial dumps */ fieldsfile = (dataset_type == 1 || dataset_type == 3 || dataset_type == 4); /* (first dim of lookup documented as being 64 or 128, so * allow header longer than n_hdr (64) -- discarding excess -- but not shorter) */ if (nlookup1 < n_hdr) { CuError(CU_EOPEN,"Opening UM file %s: unsupported header length: %d words", file->controlpath, nlookup1); ERR; } /* count the valid records in the file */ /* loop over all records and pick out the valid ones - test for LBBEGIN != -99 */ nrec=0; hdr_start = (start_lookup - 1) * ppfile->wordsize; hdr_size = nlookup1 * ppfile->wordsize; lbbegin_offset = 28 * ppfile->wordsize; CKP( valid = pp_malloc(nlookup2 * sizeof(int),heaplist) ); for (filerec=0; filerec<nlookup2; filerec++) { valid[filerec]=0; CKI( fseek(fh, hdr_start + filerec * hdr_size + lbbegin_offset, SEEK_SET) ); ERRIF( pp_read_words(&lbbegin, 1, convert_int, ppfile) !=1); if (lbbegin != -99) { /* valid record */ valid[filerec]=1; nrec++; } else { #ifdef BREAKATFIRSTINVALID break; #endif valid[filerec]=0; } } /* now read in all the PP header data */ ppfile->nrec=nrec; CKP( recs=pp_malloc(nrec*sizeof(PPrec*),heaplist) ); ppfile->recs = recs; rec=0; /* valid record number, as opposed to * filerec which is total record number */ datapos = (start_data-1) * ppfile->wordsize; #ifdef BREAKATFIRSTINVALID nlrec=nrec; #else nlrec=nlookup2; #endif for (filerec=0; filerec<nlrec ; filerec++) { if (valid[filerec]) { /* seek to correct position, read in header into tmp dynamic array, * store wanted elements in record structure, free tmp array */ CKI( fseek(fh, hdr_start + filerec*hdr_size, SEEK_SET) ); CKP( hdr=pp_read_header(ppfile,heaplist) ); CKP( recp=pp_malloc(sizeof(PPrec),heaplist) ); recs[rec]=recp; hdrp=&recp->hdr; pp_store_header(hdrp,hdr); /* Set this for UM fieldsfile, else testing an uninitialised variable in pp_var_get_extra_atts later. */ hdrp->rawhdr = NULL; CKI( pp_free(hdr,heaplist) ); /* work out datalen and disklen */ pp_evaluate_lengths(hdrp, ppfile, &recp->datalen, &recp->disklen); /* use LBBEGIN if it is set - this will not work if LBBEGIN refers to * start record rather than start address */ if (hdrp->LBBEGIN != 0) { /* Extra cast to uint handles files with LBBEGIN up to 2^32 */ recp->datapos=(size_t)((uint)hdrp->LBBEGIN)*ppfile->wordsize; } else { recp->datapos = datapos; } /* If LBNREC and LBBEGIN are both non-zero and it's not a FIELDSfile, * the file has well-formed records. In that case, * LBBEGIN should be correct, so do an assertion */ if (!fieldsfile && hdrp->LBNREC != 0 && hdrp->LBBEGIN != 0) { if (recp->datapos != hdrp->LBBEGIN * ppfile->wordsize) { CuError(CU_EOPEN,"start of data record mismatch: %d %d", recp->datapos, hdrp->LBBEGIN * ppfile->wordsize); ERR; } } datapos += recp->disklen * ppfile->wordsize; rec++; } } CKI( pp_free(valid,heaplist) ); break; default: pp_switch_bug("pp_read_all_headers"); ERR; } return 0; ERRBLKI("pp_read_all_headers"); }
size_t pp_read_words(void *ptr, size_t n, PPconvert conv, const PPfile *ppfile) { size_t i,nread,nread1; void *tmp; Fint8 dummy; /* a variable of longest word length which might be used - we point ptr at it, * and use it as a place to store a variable of that length or shorter */ CKP(ppfile); CKP(ptr); if (ppfile->wordsize == wordsize || conv==convert_none) { nread = fread(ptr, ppfile->wordsize, n, ppfile->fh); /* NOTE: for 64-bit file packed with the CRAY32 method, the following call to swapbytes will * transpose pairs of 32-bit data values. It is responsibility of calling routine to deal * with this. */ if (ppfile->swap) pp_swapbytes(ptr,ppfile->wordsize,nread); } else { tmp = &dummy; nread=0; /* read and convert a word at a time - save allocating extra memory */ for (i=0; i<n; i++) { nread1 = fread(tmp, ppfile->wordsize, 1, ppfile->fh); if (nread1==0) break; nread += nread1; if (ppfile->swap) pp_swapbytes(tmp, ppfile->wordsize, nread1); /* gruesome switches on constants in the loop - hoping the optimiser will sort it out - * I'd rather not explicitly code copies of the loop inside the switch */ switch(ppfile->wordsize) { case 4: switch(conv) { case convert_int: ((Fint *)ptr)[i] = *(Fint4 *)tmp; break; case convert_real: ((Freal *)ptr)[i] = *(Freal4 *)tmp; break; default: pp_switch_bug("pp_read_words"); ERR; } break; case 8: switch(conv) { case convert_int: ((Fint *)ptr)[i] = *(Fint8 *)tmp; break; case convert_real: ((Freal *)ptr)[i] = *(Freal8 *)tmp; break; default: pp_switch_bug("pp_read_words"); ERR; } break; default: pp_switch_bug("pp_read_words"); ERR; } } } return nread; ERRBLK("pp_read_words",0); }
void *pp_read_data_record(const PPrec *rec, const PPfile *ppfile, PPlist *heaplist) { size_t bytes, packed_bytes, nread; FILE *fh; PPconvert conv; void *data, *data_expanded, *packed_data; CuType vartype; const PPhdr *hdrp; int pack; int nint; int ipt, npoint, npoint_used; Fint valid_landmask_value, *landmask_vals; Freal mdi; const void *fill_ptr; const char *srcptr; /* points to compressed data; this could be of type Fint or Freal; * use char* instead of void* to allow ptr arithmetic */ char *destptr; /* uncompressed data */ CKP(ppfile); CKP(rec); CKP(heaplist); fh = ppfile->fh; fseek(fh, rec->datapos, SEEK_SET); hdrp=&rec->hdr; pack = pp_get_var_packing(hdrp); vartype=pp_get_var_type(hdrp); if (pack==0) { /* unpacked data -- read and convert according to type */ bytes = rec->datalen * wordsize; CKP( data = pp_malloc(bytes,heaplist) ); if (vartype==inttype) conv = convert_int; else if (vartype==realtype) conv = convert_real; else { conv=convert_none; pp_switch_bug("pp_read_data_record"); ERR; } nread = pp_read_words(data, rec->datalen, conv, ppfile); ERRIF(nread != rec->datalen); } else { /* PACKING IN USE */ /* first allocate array and read in packed data */ packed_bytes = rec->disklen * ppfile->wordsize; CKP( packed_data = pp_malloc(packed_bytes,heaplist) ); nread = pp_read_words(packed_data, rec->disklen, convert_none, ppfile); ERRIF(nread != rec->disklen); /* and allocate array for unpacked data*/ bytes = rec->datalen * wordsize; CKP( data = pp_malloc(bytes,heaplist) ); /* NOW UNPACK ACCORDING TO PACKING TYPE: */ switch(pack) { case 1: /* WGDOS */ /* for this case we will use unwgdos routine */ /* unwgdos routine wants to know number of native integers in input. * input type might not be native int, so calculate: */ nint = rec->disklen * ppfile->wordsize / sizeof(int); mdi = *(Freal*)pp_get_var_fill_value(hdrp); CKI( pp_unwgdos_wrap(packed_data, nint, data, rec->datalen, mdi, heaplist) ); break; case 2: /* CRAY 32-bit method */ if (vartype != realtype) { CuError(CU_EINTERN,"Cray 32-bit unpacking supported only for REAL type data"); ERR; } /* * in the event of a 64-bit file (which it probably is, else 32-bit packing is * redundant), and if we're on a little-endian machine, the file was written on * a cray, so the 64-bit byte swapping (whether done by cdunifpp or previously) * will have had the side-effect of swapping pairs of 32-bit words and we need * to swap them back again. * * NB LITTLE_ENDIAN_MACHINE is defined (if at all) in cdunifpp.h */ #ifdef LITTLE_ENDIAN_MACHINE if (ppfile->wordsize == 8) pp_swap32couplets(packed_data,packed_bytes); #endif for (ipt=0; ipt < rec->datalen ; ipt++) *(((Freal*) (data)) + ipt) = *(((Freal4*) (packed_data)) + ipt); break; case 3: CuError(CU_EINTERN,"GRIB unpacking not supported"); ERR; /* break; */ default: pp_switch_bug("pp_read_data_record"); ERR; } /* Okay - data unpacked - free up packed data */ CKI( pp_free(packed_data,heaplist) ); } /* if land or sea mask compression, then allocate another array, and * copy the relevant data across, filling the gaps with missing data */ if (pp_get_var_compression(hdrp) == 2) { npoint = pp_genaxis_len(ppfile->landmask->xaxis) * pp_genaxis_len(ppfile->landmask->yaxis); bytes = npoint * wordsize; CKP( data_expanded = pp_malloc(bytes,heaplist) ); switch ((hdrp->LBPACK/100)%10) { case 1: /* land mask compression */ valid_landmask_value = 1; break; case 2: /* sea mask compression */ valid_landmask_value = 0; break; default: pp_switch_bug("pp_read_data_record"); ERR; } landmask_vals = ppfile->landmask->data->values; srcptr = data; destptr = data_expanded; CKP( fill_ptr = pp_get_var_fill_value(hdrp) ); npoint_used = 0; for (ipt = 0; ipt < npoint; ipt++) { if (abs(landmask_vals[ipt]) == valid_landmask_value) { if (npoint_used >= rec->datalen) { CuError(CU_EINTERN,"Uncompressing tried to use more compressed data than available"); ERR; } memcpy(destptr,srcptr,wordsize); srcptr += wordsize; npoint_used++; } else { memcpy(destptr,fill_ptr,wordsize); } destptr += wordsize; } if (npoint_used != rec->datalen) { CuError(CU_EINTERN,"Uncompressing did not use all the compressed data"); ERR; } CKI( pp_free(data,heaplist) ); data = data_expanded; } return data; ERRBLKP("pp_read_data_record"); }
int pp_process(CuFile *file) { int rec, nrec, at_start_rec, at_end_rec; PPfile *ppfile; PPfieldvar *fvar; PPrec *recp; PPhdr *hdrp; PPgenaxis *xaxis, *yaxis, *zaxis, *taxis; /* JAK 2005-01-05 */ PPlist *heaplist; PPlist *fieldvars; PPlisthandle handle, thandle; PPlist *gatts, *catts; int ndims, dimid; int idim; /* dim number of given type */ int have_time_mean, tmdimid; /* dimensions used for meaning (CF cell methods) */ CuDim *cudims,*dim; PPdim *ppdim; int nvars, varid, cvarid; int ncvars; /* coord vars */ int nfvars; /* field vars */ int nvrec; PPrec **recs, **vrecs; CuVar *cuvars, *var; PPvar *ppvar; PPlist *atts; PPlist *axislist; PPlist *xaxes, *yaxes, *taxes, *zaxes; /* JAK 2005-01-05 */ PPgenaxis *axis; /*JAK 2005-01-10 */ int have_hybrid_sigmap; PPaxistype axistype; int rotmapid, rotgridid; PPlist *rotgrids, *rotmaps; PProtmap *rotmap; PProtgrid *rotgrid; CuVar *lonvar, *latvar; PPvar *lonppvar, *latppvar; PPlandmask *landmask; char *varnamea, *varnameb; char dimnamestem[CU_MAX_NAME], units[CU_MAX_NAME]; char formulaterms[MAX_ATT_LEN+1]; int dont_free_horiz_axes; int added; int zindex,tindex,svindex; /* ------------------------------------------------------ */ /* initialisation constants which matter */ ncvars = 0; have_hybrid_sigmap = 0; have_time_mean = 0; svindex = 1; /* initialisation constants just to avoid compiler warnings * (rather than get accustomed to ignoring warnings) * but flow logic should mean that these vars do actually get * initialised elsewhere before use */ at_end_rec=0; xaxis=yaxis=NULL; fvar=NULL; zaxis=NULL; taxis=NULL; axislist=NULL; tmdimid=-1; dont_free_horiz_axes=0; /* ------------------------------------------------------ */ ppfile = file->internp; heaplist=ppfile->heaplist; nrec = ppfile->nrec; recs = ppfile->recs; /* initialise elements in the records before sorting */ CKI( pp_initialise_records(recs, nrec, heaplist) ); /* sort the records */ qsort(recs, nrec, sizeof(PPrec*), pp_compare_records); /* now sort out the list of variables and dimensions */ CKP( fieldvars=pp_list_new(heaplist) ); CKP( xaxes=pp_list_new(heaplist) ); CKP( yaxes=pp_list_new(heaplist) ); CKP( zaxes=pp_list_new(heaplist) ); CKP( taxes=pp_list_new(heaplist) ); CKP( rotmaps=pp_list_new(heaplist) ); CKP( rotgrids=pp_list_new(heaplist) ); /* before main loop over records, look for land mask */ for (rec=0; rec<nrec ; rec++) { recp = recs[rec]; hdrp = &recp->hdr; if (pp_var_is_land_mask(hdrp)) { CKP( landmask = pp_malloc(sizeof(PPlandmask),heaplist) ); CKI( pp_set_horizontal_axes(recp,ppfile,&xaxis,&yaxis,rotmaps,heaplist) ); CKP( landmask->data = pp_data_new(inttype,pp_genaxis_len(xaxis) * pp_genaxis_len(yaxis),heaplist) ); /* JAK 2005-01-05 */ /* read in land mask data values */ landmask->xaxis = xaxis; landmask->yaxis = yaxis; CKP( landmask->data->values=pp_read_data_record(recp,ppfile,heaplist) ); ppfile->landmask = landmask; } } /* ====== START LOOP OVER RECORDS ====== */ for (rec=0; rec<nrec ; rec++) { recp = recs[rec]; hdrp = &recp->hdr; /* we are at start record of a variable at the very start, or if at we were at the * end record last time */ at_start_rec = ( rec == 0 || at_end_rec ); /* we are at end record of a variable at the very end, or if the header shows a * difference from the next record which constitutes a different variable */ at_end_rec = ( rec == nrec-1 || pp_records_from_different_vars(recs[rec+1],recp)); /*------------------------------*/ /* allow for variables which are unsupported for some reason */ if (at_start_rec) if (pp_test_skip_var(hdrp, ppfile->landmask)) continue; /* ------- if (at_start_rec) puts("++++++ START OF VARIABLE +++++++++"); printf("processing record %d / %d\n",rec,nrec); pp_dump_header(hdrp); ------ */ if (at_start_rec) { /* ====== THINGS DONE ONLY AT START RECORD OF EACH VARIABLE ====== */ /* get PPvar structure, and initialise certain structure members for tidiness */ CKP( fvar=pp_malloc(sizeof(PPfieldvar), heaplist) ); CKP( fvar->axes=pp_list_new(heaplist) ); /* JAK 2005-01-05 */ fvar->firstrecno = rec; fvar->firstrec = recp; if (pp_get_var_compression(hdrp) == 2) { /* land/sea mask compression: for horiz axes use those of LSM */ xaxis = ppfile->landmask->xaxis; yaxis = ppfile->landmask->yaxis; dont_free_horiz_axes = 1; } else { CKI( pp_set_horizontal_axes(recp,ppfile,&xaxis,&yaxis,rotmaps,heaplist) ); dont_free_horiz_axes = 0; } CKP( zaxis=pp_genaxis_new(zaxis_type,zdir,heaplist) ); CKI( pp_zaxis_set(zaxis,hdrp) ); CKP( taxis=pp_genaxis_new(taxis_type,tdir,heaplist) ); CKI( pp_taxis_set(taxis,hdrp) ); } /* construct pp_lev struct, and add it to the z axis if not already present * (could already be present if field has multiple times on each level) */ /* ====== THINGS DONE FOR EVERY PP RECORD ====== */ CKI( pp_zaxis_add(zaxis, recp->lev, &zindex, heaplist) ); recp->zindex = zindex; CKI( pp_taxis_add(taxis, recp->time, &tindex, heaplist) ); recp->tindex = tindex; /* ===================================================== */ if (at_end_rec) { /* ====== THINGS DONE ONLY AT END RECORD OF EACH VARIABLE ====== */ fvar->lastrecno = rec; nvrec = fvar->lastrecno - fvar->firstrecno + 1; vrecs = recs + fvar->firstrecno; /* now if the axes are not regular, free the axes, split the variable into a number of variables and try again... */ if (pp_set_disambig_index(zaxis, taxis, vrecs, nvrec, svindex)) { /* increment the supervar index, used later to show the connection between * the separate variables into which this one will be split */ svindex++; /* now re-sort this part of the record list, now that we have set the disambig index */ qsort(vrecs, nvrec, sizeof(PPrec*), pp_compare_records); /* now go back to the start record of the variable; set to one less because it * will get incremented in the "for" loop reinitialisation */ rec = fvar->firstrecno - 1; /* and free the stuff assoc with the var we won't be using */ if (!dont_free_horiz_axes) { CKI( pp_genaxis_free(xaxis,heaplist) ); CKI( pp_genaxis_free(yaxis,heaplist) ); } CKI( pp_genaxis_free(zaxis,heaplist) ); CKI( pp_genaxis_free(taxis,heaplist) ); CKI( pp_free(fvar,heaplist) ); continue; } /*------------------------------------------------------------*/ /* * For each axis, see if it matches an axis which already exists from a previous * variable. * * If so, then free the structure and point to the existing occurrence instead. * * If not, then add to the list. */ /* x */ CKI( added = pp_list_add_or_find(xaxes, &xaxis, pp_genaxis_compare, 0, (dont_free_horiz_axes ? NULL : (free_func) pp_genaxis_free), NULL, heaplist) ); if (added) ncvars++; /* y */ CKI( added = pp_list_add_or_find(yaxes, &yaxis, pp_genaxis_compare, 0, (dont_free_horiz_axes ? NULL : (free_func) pp_genaxis_free), NULL, heaplist) ); if (added) ncvars++; /* z */ CKI( added = pp_list_add_or_find(zaxes, &zaxis, pp_genaxis_compare, 0, (free_func) pp_genaxis_free, NULL, heaplist) ); if (added) { ncvars++; if (pp_zaxis_lev_type(zaxis) == hybrid_sigmap_lev_type) { /* two more coord vars (a and b coeffs) */ ncvars+=2; have_hybrid_sigmap=1; } if (pp_zaxis_lev_type(zaxis) == hybrid_height_lev_type) { /* two more coord vars (a and b coeffs) */ ncvars+=2; } } /* t */ CKI( added = pp_list_add_or_find(taxes, &taxis, pp_genaxis_compare, 0, (free_func) pp_genaxis_free, NULL, heaplist) ); if (added) { ncvars++; if (pp_taxis_is_time_mean(taxis)) { /* need to make sure we have the mean dim (size 2), * also one more coordinate var */ have_time_mean=1; ncvars++; } } /* associate var with these axes */ CKI( pp_list_add(fvar->axes,xaxis,heaplist) ); CKI( pp_list_add(fvar->axes,yaxis,heaplist) ); CKI( pp_list_add(fvar->axes,zaxis,heaplist) ); CKI( pp_list_add(fvar->axes,taxis,heaplist) ); /* get the rotated grid, if any * (NB this is done *after* the pp_list_add_or_find stuff above, because * otherwise the axis pointers could get orphaned if the axes are found to * be duplicates) */ CKP( fvar->rotgrid = pp_get_rotgrid(xaxis,yaxis,rotgrids,heaplist) ); /* add the variable */ CKI( pp_list_add(fieldvars, fvar, heaplist) ); /* ===================================================== */ } } /* ==================================================================== * Having completed the loop over records, we now know the number of * dimensions and variables, so we can finally do the relevant calls * to allocate these arrays and populate them usefully. * ==================================================================== */ /* FIRST ALLOCATE THE ARRAYS, and initialise some values */ nfvars = pp_list_size(fieldvars); if (nfvars <= 0) { CuError(CU_EOPEN,"No valid fields in file\n"); ERR; /* not the most elegant dealing with this error - ideally would free this file */ } ndims = pp_list_size(xaxes) + pp_list_size(yaxes) + pp_list_size(zaxes) + pp_list_size(taxes); if (have_time_mean){ tmdimid=ndims; ndims++; } if (have_hybrid_sigmap) { /* will need a scalar variable called "p0" */ ncvars++; } CKP( cudims = CuCreateDims(file,ndims) ); /* need a grid_mapping variable for every rotation mapping, * and need lon and lat variables for every rotated grid */ ncvars += pp_list_size(rotmaps) + 2*pp_list_size(rotgrids); nvars = ncvars + nfvars; CKP( cuvars = CuCreateVars(file,nvars) ); for (dimid=0; dimid<ndims; dimid++) { dim=&cudims[dimid]; dim->var = (CuVar*)0; dim->coord = (CuVar*)0; dim->datatype = realtype; dim->dimtype = CuGlobalDim; /* uncomment if internal structure is to be used * CKP( dim->internp = pp_malloc(sizeof(PPdim), heaplist) ); * ppdim=(PPdim*)dim->internp; */ } for (varid=0; varid<nvars; varid++) { var=&cuvars[varid]; var->datatype = realtype; CKP( var->internp = pp_malloc(sizeof(PPvar), heaplist) ); ppvar=(PPvar*)var->internp; ppvar->firstrecno=-1; ppvar->lastrecno=-1; ppvar->data=NULL; CKP( ppvar->atts = pp_list_new(heaplist) ); } /* * NOW POPULATE THE STRUCTURES * * The procedure will be to loop over all the axes, adding dimensions and * variables associated with those axes. * * Having done that, any dimensions not associated with axes will be added, * and then the field variables will be added. */ dimid=0; varid=0; for (axistype=0; axistype<num_axistype; axistype++) { switch(axistype){ case xaxistype: axislist=xaxes; break; case yaxistype: axislist=yaxes; break; case zaxistype: axislist=zaxes; break; case taxistype: axislist=taxes; break; default: pp_switch_bug("cdunifpp_process"); } pp_list_startwalk(axislist,&handle); idim=0; while ((axis=pp_list_walk(&handle,0))!=NULL) { dim=&cudims[dimid]; var=&cuvars[varid]; ppdim=(PPdim*) dim->internp; ppvar=(PPvar*) var->internp; dim->coord = var; axis->dimid=dimid; dim->len=pp_genaxis_len(axis); CKP( ppvar->data=pp_genaxis_getCF(axis,dimnamestem,units,ppvar->atts,heaplist) ); sprintf(dim->name,dimnamestem,idim); if (units != NULL) { strncpy(dim->units,units,CU_MAX_NAME); dim->units[CU_MAX_NAME]='\0'; } strncpy(var->name,dim->name,CU_MAX_NAME); var->name[CU_MAX_NAME]='\0'; var->ndims=1; var->dims[0] = dimid; varid++; /* now add certain variables for hybrid_sigmap z axis */ if (axistype == zaxistype && pp_zaxis_lev_type(axis) == hybrid_sigmap_lev_type) { catts=ppvar->atts; /* attribute list for the main coord var */ /* Hybrid sigma-p A coefficient */ var=&cuvars[varid]; ppvar=(PPvar*) var->internp; sprintf(var->name,"z%d_hybrid_sigmap_acoeff",idim); varnamea=var->name; CKP( ppvar->data = pp_genaxis_to_values(axis,hybrid_sigmap_a_type,heaplist) ); CKI( pp_add_string_att(ppvar->atts,"units","Pa",heaplist) ); CKI( pp_add_string_att(ppvar->atts,"long_name", "atmospheric hybrid sigma-pressure 'A' coefficient",heaplist) ); var->ndims=1; var->dims[0] = dimid; varid++; /* Hybrid sigma-p B coefficient */ var=&cuvars[varid]; ppvar=(PPvar*) var->internp; sprintf(var->name,"z%d_hybrid_sigmap_bcoeff",idim); varnameb=var->name; CKP( ppvar->data = pp_genaxis_to_values(axis,hybrid_sigmap_b_type,heaplist) ); CKI( pp_add_string_att(ppvar->atts,"long_name", "atmospheric hybrid sigma-pressure 'B' coefficient",heaplist) ); var->ndims=1; var->dims[0] = dimid; varid++; snprintf(formulaterms,MAX_ATT_LEN,"ap: %s b: %s ps: ps p0: p0",varnamea,varnameb); CKI( pp_add_string_att(catts,"formula_terms",formulaterms,heaplist) ); CKI( pp_add_string_att(catts,"standard_name","atmosphere_hybrid_sigma_pressure_coordinate",heaplist) ); CKI( pp_add_string_att(catts,"comments", "The \"ps\" term in formula_terms is set to \"ps\" variable. " "This variable may or may not be provided.",heaplist) ); } /* now add certain variables for hybrid_height z axis */ if (axistype == zaxistype && pp_zaxis_lev_type(axis) == hybrid_height_lev_type) { catts=ppvar->atts; /* attribute list for the main coord var */ /* Hybrid height A coefficient */ var=&cuvars[varid]; ppvar=(PPvar*) var->internp; sprintf(var->name,"z%d_hybrid_height_acoeff",idim); varnamea=var->name; CKP( ppvar->data = pp_genaxis_to_values(axis,hybrid_height_a_type,heaplist) ); CKI( pp_add_string_att(ppvar->atts,"units","m",heaplist) ); var->ndims=1; var->dims[0] = dimid; varid++; /* Hybrid height B coefficient */ var=&cuvars[varid]; ppvar=(PPvar*) var->internp; sprintf(var->name,"z%d_hybrid_height_bcoeff",idim); varnameb=var->name; CKP( ppvar->data = pp_genaxis_to_values(axis,hybrid_height_b_type,heaplist) ); var->ndims=1; var->dims[0] = dimid; varid++; snprintf(formulaterms,MAX_ATT_LEN,"a: %s b: %s orog: orography",varnamea,varnameb); CKI( pp_add_string_att(catts,"formula_terms",formulaterms,heaplist) ); CKI( pp_add_string_att(catts,"standard_name","atmosphere_hybrid_sigma_pressure_coordinate",heaplist) ); CKI( pp_add_string_att(catts,"comments", "The \"orog\" term in formula_terms is set to \"orography\" variable. " "This variable may or may not be provided.",heaplist) ); } /* add the boundary variable for time mean */ if (axistype == taxistype && pp_taxis_is_time_mean(axis)) { catts=ppvar->atts; /* attribute list for the main coord var */ var=&cuvars[varid]; ppvar=(PPvar*) var->internp; sprintf(var->name,"time_bnd%d",idim); CKP( ppvar->data = pp_taxis_to_boundary_values(axis->axis,heaplist) ); var->ndims=2; var->dims[0]=dimid; var->dims[1]=tmdimid; CKI( pp_add_string_att(catts,"bounds",var->name,heaplist) ); varid++; } dimid++; idim++; } /* end loop over axes of given */ } /* end loop over axis types */ /* add nv dimension if we had time mean */ if (have_time_mean) { dim=&cudims[dimid]; strcpy(dim->name,"nv"); dim->len=2; /* Should have tmdimid=dimid, but actually we already set it above (it evaluates to ndims) * as we needed it before we got here. So just do a check here. */ if ( tmdimid != dimid ) { pp_error_mesg("cdunifpp_process","ID wrong for 'nv' dimension?"); ERR; } dimid++; } /* add p0 variable if we had hybrid_sigmap coords */ if (have_hybrid_sigmap) { var=&cuvars[varid]; ppvar=(PPvar*) var->internp; sprintf(var->name,"p0"); var->ndims=0; CKI( pp_add_string_att(ppvar->atts,"long_name", "reference pressure value for atmospheric hybrid sigma-pressure coordinates", heaplist) ); /* single value consisting of p0 */ CKP( ppvar->data = pp_data_new(realtype,1,heaplist) ); ((Freal*)(ppvar->data->values))[0]=reference_pressure; varid++; } /* add any rotated_pole variables */ rotmapid=0; pp_list_startwalk(rotmaps,&handle); while ((rotmap=pp_list_walk(&handle,0))!=NULL) { var=&cuvars[varid]; ppvar=(PPvar*) var->internp; sprintf(var->name,"rotated_pole%d",rotmapid); strncpy(rotmap->name,var->name,CU_MAX_NAME); rotmap->name[CU_MAX_NAME]='\0'; /* single value of arbitrary type; set as integer = 0 */ var->datatype=inttype; var->ndims=0; CKP( ppvar->data = pp_data_new(inttype,1,heaplist) ); ((Freal*)(ppvar->data->values))[0]=0; /* and add attributes */ catts=ppvar->atts; CKI( pp_add_string_att(catts,"grid_mapping_name","rotated_latitude_longitude",heaplist) ); CKI( pp_add_att(catts,"grid_north_pole_longitude",realtype,1,&rotmap->pole_lon,heaplist) ); CKI( pp_add_att(catts,"grid_north_pole_latitude",realtype,1,&rotmap->pole_lat,heaplist) ); CKI( pp_add_att(catts,"north_pole_grid_longitude",realtype,1,&rotmap->truepole_gridlon,heaplist) ); rotmapid++; varid++; } /* and add any lon, lat variables for rotated grids */ rotgridid=0; pp_list_startwalk(rotgrids,&handle); while ((rotgrid=pp_list_walk(&handle,0))!=NULL) { lonvar=&cuvars[varid]; lonppvar=(PPvar*) lonvar->internp; varid++; latvar=&cuvars[varid]; latppvar=(PPvar*) latvar->internp; varid++; xaxis = rotgrid->xaxis; yaxis = rotgrid->yaxis; sprintf(lonvar->name,"true_lon%d",rotgridid); sprintf(latvar->name,"true_lat%d",rotgridid); sprintf(rotgrid->coords,"%s %s",lonvar->name,latvar->name); lonvar->ndims=2; latvar->ndims=2; lonvar->dims[0]=yaxis->dimid; latvar->dims[0]=yaxis->dimid; lonvar->dims[1]=xaxis->dimid; latvar->dims[1]=xaxis->dimid; CKI( pp_calc_rot_grid(rotgrid,&lonppvar->data,&latppvar->data,heaplist) ); CKI( pp_add_string_att(lonppvar->atts,"long_name","longitude",heaplist) ); CKI( pp_add_string_att(latppvar->atts,"long_name","latitude",heaplist) ); CKI( pp_add_string_att(lonppvar->atts,"standard_name","longitude",heaplist) ); CKI( pp_add_string_att(latppvar->atts,"standard_name","latitude",heaplist) ); CKI( pp_add_string_att(lonppvar->atts,"units","degrees_east",heaplist) ); CKI( pp_add_string_att(latppvar->atts,"units","degrees_north",heaplist) ); CKI( pp_add_att(lonppvar->atts,"modulo",realtype,1,&lon_modulo,heaplist) ); rotgridid++; } /* sanity check - the variable ID for the next variable to be added should * now match the number of coordinate variables */ if ( varid != ncvars ) { pp_error_mesg("cdunifpp_process","wrong number of coord vars?"); ERR; } /* add all the attributes for coord variables * (didn't do inside the loop because more complicated * for hybrid z coords / t mean) */ for (cvarid=0; cvarid<ncvars; cvarid++) { var=&cuvars[cvarid]; ppvar=(PPvar*) var->internp; CKI( pp_copy_and_free_atts(file,var,ppvar->atts,heaplist) ); } /*======================================================== * Okay we've done all the variables related to dimensions * Add the field variables. *======================================================== */ pp_list_startwalk(fieldvars,&handle); while ((fvar=pp_list_walk(&handle,0))!=NULL) { var=&cuvars[varid]; ppvar=(PPvar*) var->internp; atts = ppvar->atts; hdrp = &fvar->firstrec->hdr; CKI( pp_var_lookup(hdrp, &fvar->stashmeta) ); CKI( pp_get_var_name(varid, fvar->stashmeta.shortname, cuvars) ); var->ndims=4; /* rpw axeslist len */ /* * Axes in fvar->axes list are fastest varying first (lon,lat,lev,time) * But require them in netCDF-like order (time,lev,lat,lon), so * reverse the order while copying into var->dims. */ idim=var->ndims; pp_list_startwalk(fvar->axes,&thandle); while ((axis=pp_list_walk(&thandle,0)) != NULL) { var->dims[--idim] = axis->dimid; } var->datatype = pp_get_var_type(hdrp); ppvar->firstrecno = fvar->firstrecno; ppvar->lastrecno = fvar->lastrecno; CKI( pp_var_get_extra_atts(var, fvar, cudims, atts, heaplist) ); CKI( pp_copy_and_free_atts(file, var, atts, heaplist) ); varid++; } /* sanity check - the variable ID for the next variable to be added (if there was one, * which there isn't), should now match the total number of variables */ if ( varid != nvars ) { pp_error_mesg("cdunifpp_process","wrong number of vars?"); ERR; } /* set numbers in file structure */ file->ndims=ndims; file->nvars=nvars; file->recdim=-1; /* set global attributes */ CKP( gatts = pp_get_global_attributes(file->controlpath, ppfile, heaplist) ); CKI( pp_copy_and_free_atts(file,NULL,gatts,heaplist) ); /*======================================================== * All done and ready for dimget / varget. *======================================================== */ /* free what memory we can */ CKI( pp_free_tmp_vars(xaxes, yaxes, zaxes, taxes, fieldvars, heaplist) ); return 0; ERRBLKI("pp_process"); }