view release on metacpan or  search on metacpan

netcdf.pd  view on Meta::CPAN

           }
           RETVAL = newRV((SV *)perlarray);
           rc = nc_free_string(attlen, string_attr);
           if (rc != NC_NOERR)
              croak("Error in nc_free_string attribute %s from varid %d\n", name, varid);
           free(string_attr);
	}
OUTPUT:
	RETVAL
EOXS


#-------------------------------------------------------------------------
# Add the ability to put 'string' variable attributes (as opposed to 'text')
# using the new routine nc_put_att_string.  These strings are multiple, represented
# as a char** in C and a ref to a list of perl strings in perl.
#-------------------------------------------------------------------------
pp_addxs (<<'EOXS');

int
nc_put_att_string(ncid, varid, name, len, perlarr_ref)
        int ncid
        int varid
        char *name
        size_t len
        SV *perlarr_ref
CODE:
	{
           int i;
           char **string_attr = (char**)malloc(len * sizeof(char*));
           memset(string_attr, 0, len * sizeof(char*));
           AV *perlarr = (AV *)SvRV(perlarr_ref);
           for (i=0;i<len;i++) {
              SV** perlstr_p = av_fetch(perlarr, i, 0);
              string_attr[i] = SvPVbyte_nolen(*perlstr_p); // Assume string null-terminated!
           }
           RETVAL = nc_put_att_string(ncid, varid, name, len, (const char **)string_attr);
           if (RETVAL != NC_NOERR)
              printf("Error in nc_put_att_string for attribute %s from varid %d\n", name, varid);

           free(string_attr);
	}
OUTPUT:
	RETVAL
EOXS


#-------------------------------------------------------------------------
# Put a list of values to a bunch of 1D variables.
#-------------------------------------------------------------------------
pp_addxs (<<'EOXS');

int
c_putrec (ncid, varids, datatypes, strlen, idx, values)
  int ncid
  SV* varids
  SV* datatypes
  SV* strlen
  int idx
  SV* values
PPCODE:
  int i;
  int dt;
  int varid;

  char   c_elem;
  short  s_elem;
  ushort us_elem;
  int    i_elem;
  unsigned int ui_elem;
  longlong ll_elem;
  unsigned longlong ull_elem;
  float  f_elem;
  double d_elem;
  char  *t_elem; // Hard-coded 256 char limit to string sizes!

  STRLEN len;

  SV **elem;
  size_t nc_index[2]; // Index for use in inserting variables
  size_t nc_count[2]; // For 'classic' string variables
  int rc = NC_NOERR;  // 0
  int recsize = av_len((AV *)SvRV(varids)) + 1;
  nc_index[0] = idx;  // index to put
  nc_index[1] = 0;    // For string variables
  nc_count[0] = 1;    // For string variables

  // loop over input variables
  for (i=0; i<recsize; i++) {
    elem = av_fetch((AV *)SvRV(datatypes), i, 0); // elem is perl SV for the datatype
    dt   = (int)SvIV(*elem); // dt is the data type of the current variable (C int)

    elem  = av_fetch((AV *)SvRV(varids), i, 0);
    varid = (int)SvIV(*elem);

    elem  = av_fetch((AV *)SvRV(values), i, 0); // perl SV for current value

    if (dt == NC_BYTE) {
      c_elem = (char)SvIV(*elem); // element to put
      rc = nc_put_var1_schar  (ncid, varid, nc_index, &c_elem);
    } else if (dt == NC_SHORT) {
      s_elem = (short)SvIV(*elem); // element to put
      rc = nc_put_var1_short  (ncid, varid, nc_index, &s_elem);
    } else if (dt == NC_INT) {
      i_elem = (int)SvIV(*elem); // element to put
      rc = nc_put_var1_int    (ncid, varid, nc_index, &i_elem);
#ifdef NC_NETCDF4
    } else if (dt == NC_USHORT) {
      us_elem = (ushort)SvIV(*elem); // element to put
      rc = nc_put_var1_ushort  (ncid, varid, nc_index, &us_elem);
    } else if (dt == NC_UINT) {
      ui_elem = (unsigned int)SvIV(*elem); // element to put
      rc = nc_put_var1_uint    (ncid, varid, nc_index, &ui_elem);
    } else if (dt == NC_INT64) {
      ll_elem = (longlong)SvIV(*elem); // element to put
      rc = nc_put_var1_longlong    (ncid, varid, nc_index, &ll_elem);
    } else if (dt == NC_UINT64) {
      ull_elem = (unsigned longlong)SvIV(*elem); // element to put
      rc = nc_put_var1_ulonglong    (ncid, varid, nc_index, &ll_elem);
#endif
    } else if (dt == NC_FLOAT) {
      f_elem = (float)SvNV(*elem); // element to put
      rc = nc_put_var1_float  (ncid, varid, nc_index, &f_elem);
    } else if (dt == NC_DOUBLE) {
      d_elem = (double)SvNV(*elem); // element to put
      rc = nc_put_var1_double (ncid, varid, nc_index, &d_elem);
    } else if (dt == NC_CHAR) {
      t_elem = (char *)SvPV(*elem, len); // element to put
      elem = av_fetch((AV *)SvRV(strlen), i, 0); // elem is perl SV for the length of this string dimension
      nc_count[1] = (int)SvIV(*elem); // nc_count[1] is the length of the string dimension for this variable
      rc = nc_put_vara_text   (ncid, varid, nc_index, nc_count, t_elem);
    }
    if (rc != NC_NOERR)
      croak("Error writing NCID %d: %s\n", varid, nc_strerror(rc));
  }
EOXS

#-------------------------------------------------------------------------
# Get a list of values from a bunch of 1D variables.
#-------------------------------------------------------------------------
pp_addxs (<<'EOXS');

int
c_getrec (ncid, varids, datatypes, strlen, idx)
  int ncid
  SV* varids
  SV* datatypes
  SV* strlen
  int idx
PPCODE:
  int i;
  int dt;
  int varid;

  char   c_elem;
  short  s_elem;
  ushort us_elem;
  int    i_elem;
  longlong ll_elem;
  float  f_elem;
  double d_elem;
  char   t_elem[256]; // Hard-coded 256 char limit to string sizes!

  SV **elem;
  size_t nc_index[2]; // Index for use in inserting variables
  size_t nc_count[2]; // For 'classic' string variables
  int rc = NC_NOERR;  // 0
  int recsize = av_len((AV *)SvRV(varids)) + 1;
  nc_index[0] = idx;  // index to put
  nc_index[1] = 0;    // For string variables
  nc_count[0] = 1;    // For string variables

  // loop over input variables
  for (i=0; i<recsize; i++) {
    elem = av_fetch((AV *)SvRV(datatypes), i, 0); // elem is perl SV for the datatype
    dt   = (int)SvIV(*elem); // dt is the data type of the current variable (C int)

    elem   = av_fetch((AV *)SvRV(varids), i, 0);
    varid  = (int)SvIV(*elem);

    EXTEND (SP, 1);
    if (dt == NC_BYTE) {
      rc = nc_get_var1_schar (ncid, varid, nc_index, &c_elem);
      PUSHs (sv_2mortal (newSViv ((IV)c_elem)));
    } else if (dt == NC_SHORT) {
      rc = nc_get_var1_short (ncid, varid, nc_index, &s_elem);
      PUSHs (sv_2mortal (newSViv ((IV)s_elem)));
    } else if (dt == NC_INT) {
      rc = nc_get_var1_int   (ncid, varid, nc_index, &i_elem);
      PUSHs (sv_2mortal (newSViv ((IV)i_elem)));
#ifdef NC_NETCDF4
    } else if (dt == NC_USHORT) {
      rc = nc_get_var1_ushort   (ncid, varid, nc_index, &us_elem);
      PUSHs (sv_2mortal (newSViv ((IV)us_elem)));
    } else if (dt == NC_UINT) {
      rc = nc_get_var1_uint   (ncid, varid, nc_index, &i_elem);
      PUSHs (sv_2mortal (newSViv ((IV)i_elem)));
    } else if (dt == NC_INT64) {
      rc = nc_get_var1_longlong   (ncid, varid, nc_index, &ll_elem);
      PUSHs (sv_2mortal (newSViv ((IV)ll_elem)));
    } else if (dt == NC_UINT64) {
      rc = nc_get_var1_ulonglong   (ncid, varid, nc_index, &ll_elem);
      PUSHs (sv_2mortal (newSViv ((IV)ll_elem)));
#endif
    } else if (dt == NC_FLOAT) {
      rc = nc_get_var1_float (ncid, varid, nc_index, &f_elem);
      PUSHs (sv_2mortal (newSVnv ((double)f_elem)));
    } else if (dt == NC_DOUBLE) {
      rc = nc_get_var1_double (ncid, varid, nc_index, &d_elem);
      PUSHs (sv_2mortal (newSVnv (d_elem)));