Пример #1
0
NhlErrorTypes ut_calendar_W( void )
{
/*
 * Input array variables
 */
  void *x;
  double *tmp_x;
  NrmQuark *sspec = NULL;
  char *cspec, *cspec_orig;
  int *option;
  int ndims_x;
  ng_size_t dsizes_x[NCL_MAX_DIMENSIONS];
  int has_missing_x;
  NclScalar missing_x, missing_dx;
  NclBasicDataTypes type_x;
/* 
 * Variables for calculating fraction of year,  if the option is 4.
 */
  int doy, nsid, total_seconds_in_year, seconds_in_doy, seconds_in_hour;
  int seconds_in_minute; 
  double current_seconds_in_year, fraction_of_year;

/*
 * Variables for retrieving attributes from the first argument.
 */
  NclAttList  *attr_list;
  NclAtt  attr_obj;
  NclStackEntry   stack_entry;
  NrmQuark *scal;
  char   *ccal = NULL;
/*
 * Variables for Udunits package.
 */
  ut_system *utopen_ncl(), *unit_system;
  ut_unit *utunit;
/*
 * Output variables.
 */
  int year, month, day, hour, minute;
  double second;
  void *date = NULL;
  int ndims_date = 0;
  ng_size_t *dsizes_date;
  NclScalar missing_date;
  NclBasicDataTypes type_date = NCL_none;
  NclObjClass type_date_t = NCL_none;
/*
 * Variables for returning "calendar" attribute.
 */
  int att_id;
  NclQuark *calendar;
  NclMultiDValData att_md, return_md;
  NclVar tmp_var;
  NclStackEntry return_data;

/*
 * various
 */
  int ret, return_missing;
  ng_size_t dsizes[1];
  ng_size_t i, total_size_x;
  ng_size_t total_size_date = 0;
  ng_size_t index_date;
  int months_to_days_fix=0, years_to_days_fix=0;
  extern float truncf(float);

/*
 * Before we do anything, initialize the Udunits package.
 */
  unit_system = utopen_ncl();

/*
 * Retrieve parameters
 *
 * Note any of the pointer parameters can be set to NULL, which
 * implies you don't care about its value.
 */
  x = (void*)NclGetArgValue(
           0,
           2,
           &ndims_x, 
           dsizes_x,
           &missing_x,
           &has_missing_x,
           &type_x,
           DONT_CARE);
/*
 * Get option.
 */

  option = (int*)NclGetArgValue(
           1,
           2,
           NULL,
           NULL,
           NULL,
           NULL,
           NULL,
           1);

/* 
 * The "units" attribute of "time" must be set, otherwise missing
 * values will be returned.
 *
 * The "calendar" option may optionally be set, but it must be equal to
 * one of the recognized calendars.
 */
  return_missing = 0;

  stack_entry = _NclGetArg(0, 2, DONT_CARE);
  switch (stack_entry.kind) {
  case NclStk_VAR:
    if (stack_entry.u.data_var->var.att_id != -1) {
      attr_obj = (NclAtt) _NclGetObj(stack_entry.u.data_var->var.att_id);
      if (attr_obj == NULL) {
        return_missing = 1;
        break;
      }
    }
    else {
/*
 * att_id == -1 ==> no attributes specified; return all missing.
 */
      return_missing = 1;
      break;
    }
/* 
 * Check for attributes. If none are specified, then return missing values.
 */
    if (attr_obj->att.n_atts == 0) {
      return_missing = 1;
      break;
    }
    else {
/*
 * Get list of attributes.
 */
      attr_list = attr_obj->att.att_list;
/*
 * Loop through attributes and check them.
 */
      while (attr_list != NULL) {
        if ((strcmp(attr_list->attname, "calendar")) == 0) {
          scal = (NrmQuark *) attr_list->attvalue->multidval.val;
          ccal = NrmQuarkToString(*scal);
          if(strcasecmp(ccal,"standard") && strcasecmp(ccal,"gregorian") &&
             strcasecmp(ccal,"noleap") && strcasecmp(ccal,"365_day") &&
             strcasecmp(ccal,"365") && strcasecmp(ccal,"360_day") && 
             strcasecmp(ccal,"360") ) {
            NhlPError(NhlWARNING,NhlEUNKNOWN,"ut_calendar: the 'calendar' attribute is not equal to a recognized calendar. Returning all missing values.");
            return_missing = 1;
          }
        }
        if ((strcmp(attr_list->attname, "units")) == 0) {
          sspec = (NrmQuark *) attr_list->attvalue->multidval.val;
        }
        attr_list = attr_list->next;
      }
    }
  default:
    break;
  }

/*
 * Convert sspec to character string.
 */
  if(sspec == NULL) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"ut_calendar: no 'units' attribute provided");
    return(NhlFATAL);
  }
  cspec = NrmQuarkToString(*sspec);

/*
 * There's a bug in utInvCalendar2_cal that doesn't handle the
 * 360-day calendar correctly if units are "years since" or
 * "months since".
 *
 * To fix this bug, we convert these units to "days since", do the
 * calculation as "days since", and then convert back to the original
 * "years since" or "months since" requested units.
 */
  cspec_orig = (char*)calloc(strlen(cspec)+1,sizeof(char));
  strcpy(cspec_orig,cspec);

  cspec = fix_units_for_360_bug(ccal,cspec,&months_to_days_fix,
                                &years_to_days_fix);
/*
 * Make sure cspec is a valid udunits string.
 */
  utunit = ut_parse(unit_system, cspec, UT_ASCII);
  if(utunit == NULL) {
    NhlPError(NhlWARNING,NhlEUNKNOWN,"ut_calendar: Invalid specification string. Missing values will be returned.");
    return_missing = 1;
  }
/*
 * Calculate size of input array.
 */
  total_size_x = 1;
  for( i = 0; i < ndims_x; i++ ) total_size_x *= dsizes_x[i];

/*
 * Calculate size and dimensions for output array, and allocate
 * memory for output array.  The output size will vary depending
 * on what option the user has specified.  Only options -5 to 4
 * are currently recognized. (option = -4 doesn't exist.)
 */

  if(*option < -5 || *option > 4 || *option == -4) {
        NhlPError(NhlWARNING,NhlEUNKNOWN,"ut_calendar: Unknown option, defaulting to 0.");
        *option = 0;
  }

  if(*option == 0) {
        type_date   = NCL_float;
        type_date_t = nclTypefloatClass;
        total_size_date = 6 * total_size_x;
        missing_date    = ((NclTypeClass)nclTypefloatClass)->type_class.default_mis;
        ndims_date      = ndims_x + 1;
        date            = (float *)calloc(total_size_date,sizeof(float));
  }
  else if(*option == -5) {
/* identical to option=0, except returns ints */
        type_date       = NCL_int;
        type_date_t     = nclTypeintClass;
        total_size_date = 6 * total_size_x;
        missing_date    = ((NclTypeClass)nclTypeintClass)->type_class.default_mis;
        ndims_date      = ndims_x + 1;
        date            = (int *)calloc(total_size_date,sizeof(int));
  }
  else if(*option >= 1 && *option <= 4) {
        type_date       = NCL_double;
        type_date_t     = nclTypedoubleClass;
        total_size_date = total_size_x;
        missing_date    = ((NclTypeClass)nclTypedoubleClass)->type_class.default_mis;
        ndims_date      = ndims_x;
        date            = (double *)calloc(total_size_date,sizeof(double));
  }
  else if(*option >= -3 && *option <= -1) {
        type_date       = NCL_int;
        type_date_t     = nclTypeintClass;
        total_size_date = total_size_x;
        missing_date    = ((NclTypeClass)nclTypeintClass)->type_class.default_mis;
        ndims_date      = ndims_x;
        date            = (int *)calloc(total_size_date,sizeof(int));
  }
  dsizes_date = (ng_size_t *)calloc(ndims_date,sizeof(ng_size_t));

/*
 * Make sure we have enough memory for output.
 */
  if( date == NULL || dsizes_date == NULL) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"ut_calendar: Unable to allocate memory for output arrays");
    return(NhlFATAL);
  }

/*
 * Calculate output dimension sizes.
 */
  for( i = 0; i < ndims_x; i++ ) dsizes_date[i] = dsizes_x[i];
  if(*option == 0 || *option == -5) {
        dsizes_date[ndims_x] = 6;
  }

/*
 * Coerce missing values to double.
 */
  coerce_missing(type_x,has_missing_x,&missing_x,&missing_dx,NULL);

/* 
 * If we reach this point and return_missing is not 0, then either
 * "units" was invalid or wasn't set, or "calendar" was not a
 * recoginized calendar. We return all missing values in this case.
 */
  if(return_missing) {
        if(*option == 0) {
          for(i = 0; i < total_size_date; i++ ) {
                ((float*)date)[i] = missing_date.floatval;
          }
        }
        else if(*option == -5) {
/* identical to option=0, except returns ints */
          for(i = 0; i < total_size_date; i++ ) {
                ((int*)date)[i] = missing_date.intval;
          }
        }
        else if(*option >= 1 && *option <= 4) {
          for(i = 0; i < total_size_date; i++ ) {
                ((double*)date)[i] = missing_date.doubleval;
          }
        }
        else if(*option >= -3 && *option <= -1) {
          for(i = 0; i < total_size_date; i++ ) {
                ((int*)date)[i] = missing_date.intval;
          }
        }
/*
 * Return all missing values.
 */
    ret = NclReturnValue(date,ndims_date,dsizes_date,
                          &missing_date,type_date,0);
    NclFree(dsizes_date);
    return(ret);
  }
            
/*
 * Convert input to double if necessary.
 */
  tmp_x = coerce_input_double(x,type_x,total_size_x,has_missing_x,&missing_x,
                  &missing_dx);

/*
 * This is the bug fix for 360 day calendars and a units
 * of "years since" or "months since". We have to convert
 * from "years since" or "months since" to "days since".
 *
 * See above for more information about the bug.
 */
  if(years_to_days_fix == 1) {
    for(i = 0; i < total_size_x; i++ ) tmp_x[i] *= 360.;
  }
  if(months_to_days_fix == 1) {
    for(i = 0; i < total_size_x; i++ ) tmp_x[i] *= 30.;
  }


/* 
 * Loop through each element and get the 6 values.
 */
  index_date = 0;
  for( i = 0; i < total_size_x; i++ ) {
    if(!has_missing_x ||
       (has_missing_x && tmp_x[i] != missing_dx.doubleval)) {
      (void) utCalendar2_cal(tmp_x[i],utunit,&year,&month,&day,
                             &hour,&minute,&second,ccal);
/*
 * Calculate the return values, based on the input option.
 */
      switch(*option) {

      case 0:
        ((float*)date)[index_date]   = (float)year;
        ((float*)date)[index_date+1] = (float)month;
        ((float*)date)[index_date+2] = (float)day;
        ((float*)date)[index_date+3] = (float)hour;
        ((float*)date)[index_date+4] = (float)minute;
        ((float*)date)[index_date+5] = second;
        break;

/* identical to option=0, except returns ints */
      case -5:
        ((int*)date)[index_date]   = year;
        ((int*)date)[index_date+1] = month;
        ((int*)date)[index_date+2] = day;
        ((int*)date)[index_date+3] = hour;
        ((int*)date)[index_date+4] = minute;
        ((int*)date)[index_date+5] = (int)truncf(second);
        break;

/*
 * YYYYMM
 */
      case -1:
        ((int*)date)[index_date] = (100*year) + month;
        break;

      case 1:
        ((double*)date)[index_date] = (double)(100*year) + (double)month;
        break;
/*
 * YYYYMMDD
 */
      case -2:
        ((int*)date)[index_date] = (10000*year) + (100*month) + day;
        break;

      case 2:
        ((double*)date)[index_date] = (double)(10000*year)
          + (double)(100*month) 
          + (double)day;
        break;

/*
 * YYYYMMDDHH
 */
      case -3:
        ((int*)date)[index_date] = (1000000*year) + (10000*month) 
          + (100*day) + hour;                
        break;
                
      case 3:
        ((double*)date)[index_date] = (double)(1000000*year) 
          + (double)(10000*month) 
          + (double)(100*day)
          + (double)hour;             
        break;
                
/*
 *  YYYY.fraction_of_year
 */
      case 4:
	nsid = 86400;      /* num seconds in a day */
        if(ccal == NULL) {
          total_seconds_in_year = seconds_in_year(year,"standard");
          doy = day_of_year(year,month,day,"standard");
        }
        else {
          total_seconds_in_year = seconds_in_year(year,ccal);
          doy = day_of_year(year,month,day,ccal);
        }
        if(doy > 1) {
          seconds_in_doy = (doy-1) * nsid;
        }
        else {
          seconds_in_doy = 0;
        }
        if(hour > 1) {
          seconds_in_hour  = (hour-1) * 3600;
        }
        else {
          seconds_in_hour  = 0;
        }
        if(minute > 1) {
          seconds_in_minute  = (minute-1) * 60;
        }
        else {
          seconds_in_minute  = 0;
        }
        current_seconds_in_year = seconds_in_doy + 
          seconds_in_hour + 
          seconds_in_minute + 
          second;
        fraction_of_year = current_seconds_in_year/(double)total_seconds_in_year;
        ((double*)date)[index_date] = (double)year + fraction_of_year;
        break;
      }
    }
    else {
      switch(*option) {

      case 0:
        ((float*)date)[index_date]   = missing_date.floatval;
        ((float*)date)[index_date+1] = missing_date.floatval;
        ((float*)date)[index_date+2] = missing_date.floatval;
        ((float*)date)[index_date+3] = missing_date.floatval;
        ((float*)date)[index_date+4] = missing_date.floatval;
        ((float*)date)[index_date+5] = missing_date.floatval;
        break;

/* identical to option=0, except returns ints */
      case -5:
        ((int*)date)[index_date]   = missing_date.intval;
        ((int*)date)[index_date+1] = missing_date.intval;
        ((int*)date)[index_date+2] = missing_date.intval;
        ((int*)date)[index_date+3] = missing_date.intval;
        ((int*)date)[index_date+4] = missing_date.intval;
        ((int*)date)[index_date+5] = missing_date.intval;
        break;

      case 1:
      case 2:
      case 3:
      case 4:
        ((double*)date)[index_date] = missing_date.doubleval;
        break;

      case -1:
      case -2:
      case -3:
        ((int*)date)[index_date] = missing_date.intval;
        break;
      }
    }
    if(*option == 0 || *option == -5) {
      index_date += 6;
    }
    else {
      index_date++;
    }
  }

/*
 * Free the work arrays.
 */

  if(type_x != NCL_double) NclFree(tmp_x);

/*
 * Close up Udunits.
 */
  utclose_ncl(unit_system);

/*
 * Free extra units
 */
  NclFree(cspec_orig);

  ut_free(utunit);

/*
 * Set up variable to return.
 */
  if(has_missing_x) {
        return_md = _NclCreateVal(
                            NULL,
                            NULL,
                            Ncl_MultiDValData,
                            0,
                            date,
                            &missing_date,
                            ndims_date,
                            dsizes_date,
                            TEMPORARY,
                            NULL,
                            type_date_t
                            );
  }
  else {
        return_md = _NclCreateVal(
                            NULL,
                            NULL,
                            Ncl_MultiDValData,
                            0,
                            date,
                            NULL,
                            ndims_date,
                            dsizes_date,
                            TEMPORARY,
                            NULL,
                            type_date_t
                            );
  }

/*
 * Set up attributes to return.
 */
  att_id = _NclAttCreate(NULL,NULL,Ncl_Att,0,NULL);
  dsizes[0] = 1;

/*
 * Return "calendar" attribute.
 *
 * We can't just return "scal" here, because it's an NCL input
 * parameter and this seems to screw things up if we try to
 * return it as an attribute.
 */
  calendar = (NclQuark*)NclMalloc(sizeof(NclQuark));
  if(ccal != NULL) {
    *calendar = NrmStringToQuark(ccal);
  }
  else {
    *calendar = NrmStringToQuark("standard");
  }
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         (void*)calendar,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         (NclObjClass)nclTypestringClass
                         );
  _NclAddAtt(
             att_id,
             "calendar",
             att_md,
             NULL
             );

  tmp_var = _NclVarCreate(
                          NULL,
                          NULL,
                          Ncl_Var,
                          0,
                          NULL,
                          return_md,
                          NULL,
                          att_id,
                          NULL,
                          RETURNVAR,
                          NULL,
                          TEMPORARY
                          );

    NclFree(dsizes_date);
/*
 * Return output grid and attributes to NCL.
 */
  return_data.kind = NclStk_VAR;
  return_data.u.data_var = tmp_var;
  _NclPlaceReturn(return_data);
  return(NhlNOERROR);
}
Пример #2
0
NhlErrorTypes ut_inv_calendar_W( void )
{
/*
 * Input array variables
 */
  int *year, *month, *day, *hour, *minute;
  void *second;
  double *tmp_second = NULL;
  NrmQuark *sspec;
  int *option;
  char *cspec, *cspec_orig;
  int ndims_year;
  ng_size_t dsizes_year[NCL_MAX_DIMENSIONS];
  int has_missing_year;
  int ndims_month;
  ng_size_t dsizes_month[NCL_MAX_DIMENSIONS];
  int has_missing_month;
  int ndims_day;
  ng_size_t dsizes_day[NCL_MAX_DIMENSIONS];
  int has_missing_day;
  int ndims_hour;
  ng_size_t dsizes_hour[NCL_MAX_DIMENSIONS];
  int has_missing_hour;
  int ndims_minute;
  ng_size_t dsizes_minute[NCL_MAX_DIMENSIONS];
  int has_missing_minute;
  int ndims_second;
  ng_size_t dsizes_second[NCL_MAX_DIMENSIONS];
  int has_missing_second;
  NclScalar missing_year;
  NclScalar missing_month;
  NclScalar missing_day;
  NclScalar missing_hour;
  NclScalar missing_minute;
  NclScalar missing_second;
  NclBasicDataTypes type_second;
/*
 * Variables for Udunits package.
 */
  ut_system *utopen_ncl(), *unit_system;
  ut_unit *utunit;
/*
 * Variables for retrieving attributes from last argument.
 */
  NclAttList  *attr_list;
  NclAtt  attr_obj;
  NclStackEntry stack_entry;
  NrmQuark *scal;
  char   *ccal = NULL;
/*
 * Output variables.
 */
  double *x;
  int has_missing_x;
  NclScalar missing_x;
/*
 * Variables for returning "units" and "calendar" attributes.
 */
  NclQuark *units, *calendar;
  int att_id;
  NclMultiDValData att_md, return_md;
  NclVar tmp_var;
  NclStackEntry return_data;

/*
 * various
 */
  ng_size_t i, total_size_input;
  ng_size_t dsizes[1], return_missing;
  int months_to_days_fix=0, years_to_days_fix=0;

/*
 * Before we do anything, initialize the Udunits package.
 */
  unit_system = utopen_ncl();

/*
 * Retrieve parameters
 *
 * Note any of the pointer parameters can be set to NULL, which
 * implies you don't care about its value.
 * The first size input arrays must be the same dimension sizes.
 */
  year = (int*)NclGetArgValue(
           0,
           8,
           &ndims_year, 
           dsizes_year,
           &missing_year,
           &has_missing_year,
           NULL,
           DONT_CARE);
  month = (int*)NclGetArgValue(
           1,
           8,
           &ndims_month, 
           dsizes_month,
           &missing_month,
           &has_missing_month,
           NULL,
           DONT_CARE);
  day = (int*)NclGetArgValue(
           2,
           8,
           &ndims_day, 
           dsizes_day,
           &missing_day,
           &has_missing_day,
           NULL,
           DONT_CARE);
  hour = (int*)NclGetArgValue(
           3,
           8,
           &ndims_hour, 
           dsizes_hour,
           &missing_hour,
           &has_missing_hour,
           NULL,
           DONT_CARE);
  minute = (int*)NclGetArgValue(
           4,
           8,
           &ndims_minute, 
           dsizes_minute,
           &missing_minute,
           &has_missing_minute,
           NULL,
           DONT_CARE);
  second = (void*)NclGetArgValue(
           5,
           8,
           &ndims_second, 
           dsizes_second,
           &missing_second,
           &has_missing_second,
           &type_second,
           DONT_CARE);

  if(ndims_year != ndims_month || ndims_year != ndims_day    || 
     ndims_year != ndims_hour  || ndims_year != ndims_minute ||
     ndims_year != ndims_second) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"ut_inv_calendar: The first six arguments must have the same dimensionality");
    return(NhlFATAL);
  }

  for(i = 0; i < ndims_year; i++ ) {
    if(dsizes_year[i] != dsizes_month[i]  ||
       dsizes_year[i] != dsizes_day[i]    || 
       dsizes_year[i] != dsizes_hour[i]   || 
       dsizes_year[i] != dsizes_minute[i] ||
       dsizes_year[i] != dsizes_second[i]) {
      
      NhlPError(NhlFATAL,NhlEUNKNOWN,"ut_inv_calendar: The first six arguments must have the same dimensionality");
      return(NhlFATAL);
    }
  }
/* 
 * x will contain a _FillValue attribute if any of the input
 * has a _FillValue attribute set.
 */
  if(has_missing_year || has_missing_month || has_missing_day ||
     has_missing_hour || has_missing_minute || has_missing_second) {
    has_missing_x = 1;
/*
 * Get the default missing value for a double type.
 */
    missing_x = ((NclTypeClass)nclTypedoubleClass)->type_class.default_mis;
  }
  else {
    has_missing_x = 0;
  }
/*
 * Get spec string.
 */
  sspec = (NrmQuark *)NclGetArgValue(
           6,
           8,
           NULL,
           NULL,
           NULL,
           NULL,
           NULL,
           1);
/*
 * Get option.
 */
  option = (int*)NclGetArgValue(
           7,
           8,
           NULL,
           NULL,
           NULL,
           NULL,
           NULL,
           1);

/* 
 * Check the "option" variable to see if it contains a "calendar"
 * attribute.
 */
  return_missing = 0;

  stack_entry = _NclGetArg(7, 8, DONT_CARE);
  switch (stack_entry.kind) {
  case NclStk_VAR:
    if (stack_entry.u.data_var->var.att_id != -1) {
      attr_obj = (NclAtt) _NclGetObj(stack_entry.u.data_var->var.att_id);
      if (attr_obj == NULL) {
        break;
      }
    }
    else {
/*
 * att_id == -1 ==> no attributes specified args given.
 */
      break;
    }
/* 
 * Get optional arguments.
 */
    if (attr_obj->att.n_atts > 0) {
/*
 * Get list of attributes.
 */
      attr_list = attr_obj->att.att_list;
/*
 * Loop through attributes and check them.
 */
      while (attr_list != NULL) {
        if ((strcmp(attr_list->attname, "calendar")) == 0) {
          scal = (NrmQuark *) attr_list->attvalue->multidval.val;
          ccal = NrmQuarkToString(*scal);
          if(strcasecmp(ccal,"standard") && strcasecmp(ccal,"gregorian") &&
             strcasecmp(ccal,"noleap") && strcasecmp(ccal,"365_day") &&
             strcasecmp(ccal,"365") && strcasecmp(ccal,"360_day") && 
             strcasecmp(ccal,"360") ) {
            NhlPError(NhlWARNING,NhlEUNKNOWN,"ut_inv_calendar: the 'calendar' attribute is not equal to a recognized calendar. Returning all missing values.");
            return_missing = has_missing_x = 1;
          }
        }
        attr_list = attr_list->next;
      }
    }
  default:
    break;
  }

/*
 * Convert sspec to character string.
 */
  cspec = NrmQuarkToString(*sspec);

/*
 * There's a bug in utInvCalendar2_cal that doesn't handle the
 * 360-day calendar correctly if units are "years since" or
 * "months since".
 *
 * To fix this bug, we convert these units to "days since", do the
 * calculation as "days since", and then convert back to the original
 * "years since" or "months since" requested units.
 */
  cspec_orig = (char*)calloc(strlen(cspec)+1,sizeof(char));
  strcpy(cspec_orig,cspec);

  cspec = fix_units_for_360_bug(ccal,cspec,&months_to_days_fix,
                                &years_to_days_fix);

/*
 * Make sure cspec is a valid udunits string.
 */
  utunit = ut_parse(unit_system, cspec, UT_ASCII);
  if(utunit == NULL) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"ut_inv_calendar: Invalid specification string");
    return(NhlFATAL);
  }

/*
 * Calculate total size of input arrays, and size and dimensions for
 * output array, and alloc memory for output array.
 */
  total_size_input = 1;
  for( i = 0; i < ndims_year; i++ ) total_size_input *= dsizes_year[i];

  x = (double *)calloc(total_size_input,sizeof(double));

  if( x == NULL ) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"ut_inv_calendar: Unable to allocate memory for output array");
    return(NhlFATAL);
  }
/*
 * Create tmp array for coercing second to double if necessary.
 */
  if(type_second != NCL_double) {
    tmp_second = (double*)calloc(1,sizeof(double));
    if(tmp_second == NULL) {
      NhlPError(NhlFATAL,NhlEUNKNOWN,"ut_inv_calendar: Unable to allocate memory for coercing second array to double precision");
      return(NhlFATAL);
    }
  }

/* 
 * Loop through each data value, and call Udunits routine.
 */ 
  for( i = 0; i < total_size_input; i++ ) {
/*
 * Coerce "second" to double, since this is what the original Udunits
 * routine is expecting. 
 */
    if(type_second != NCL_double) {
      coerce_subset_input_double(second,tmp_second,i,type_second,1,
                                 has_missing_second,&missing_second,NULL);
    }
    else {
      tmp_second = &((double*)second)[i];
    }

    if(!return_missing && (!has_missing_year   ||
        (has_missing_year && year[i]       != missing_year.intval))   &&
       (!has_missing_month ||
         (has_missing_month && month[i]    != missing_month.intval))  &&
       (!has_missing_day ||
         (has_missing_day && day[i]        != missing_day.intval))    &&
       (!has_missing_hour ||
         (has_missing_hour  && hour[i]     != missing_hour.intval))   &&
       (!has_missing_minute ||
         (has_missing_minute && minute[i]  != missing_minute.intval)) &&
       (!has_missing_second ||
        (has_missing_second && *tmp_second != missing_second.doubleval)) ) {

       (void)utInvCalendar2_cal(year[i],month[i],day[i],hour[i],
                                minute[i],*tmp_second,utunit,&x[i],ccal);

/*
 * This is the bug fix for 360 day calendars and a units
 * of "years since" or "months since". We have to convert
 * from "days since" to the original requested units.
 *
 * See above for more information about the bug.
 */
       if(years_to_days_fix  == 1) x[i] /= 360.;
       if(months_to_days_fix == 1) x[i] /= 30.;
    }
    else {
      x[i]  = missing_x.doubleval;
    }
  }

/*
 * Close up Udunits.
 */
  utclose_ncl(unit_system);

/*
 * Set original units back if necessary.
 */
  if(months_to_days_fix || years_to_days_fix) {
    cspec = cspec_orig;
  }
  else {
    NclFree(cspec_orig);
  }

  if(type_second != NCL_double) NclFree(tmp_second);

/*
 * Set up variable to return.
 */
  if(has_missing_x) {
        return_md = _NclCreateVal(
                            NULL,
                            NULL,
                            Ncl_MultiDValData,
                            0,
                            x,
                            &missing_x,
                            ndims_year,
                            dsizes_year,
                            TEMPORARY,
                            NULL,
                            (NclObjClass)nclTypedoubleClass
                            );
  }
  else {
        return_md = _NclCreateVal(
                            NULL,
                            NULL,
                            Ncl_MultiDValData,
                            0,
                            x,
                            NULL,
                            ndims_year,
                            dsizes_year,
                            TEMPORARY,
                            NULL,
                            (NclObjClass)nclTypedoubleClass
                            );
  }

/*
 * Set up attributes to return.
 */
  att_id = _NclAttCreate(NULL,NULL,Ncl_Att,0,NULL);
  dsizes[0] = 1;

/*
 * Return "units" attribute.
 *
 * We can't just return "sspec" here, because it's an NCL input
 * parameter and this seems to screw things up if we try to
 * return it as an attribute.
 */
  units  = (NclQuark*)NclMalloc(sizeof(NclQuark));
  *units = NrmStringToQuark(cspec);

  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         (void*)units,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         (NclObjClass)nclTypestringClass
                         );
  _NclAddAtt(
             att_id,
             "units",
             att_md,
             NULL
             );

/*
 * Return "calendar" attribute.
 *
 * We can't just return "sspec" here, because it's an NCL input
 * parameter and this seems to screw things up if we try to
 * return it as an attribute.
 */
  calendar = (NclQuark*)NclMalloc(sizeof(NclQuark));
  if(ccal != NULL) {
    *calendar = NrmStringToQuark(ccal);
  }
  else {
    *calendar = NrmStringToQuark("standard");
  }
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         (void*)calendar,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         (NclObjClass)nclTypestringClass
                         );
  _NclAddAtt(
             att_id,
             "calendar",
             att_md,
             NULL
             );

  tmp_var = _NclVarCreate(
                          NULL,
                          NULL,
                          Ncl_Var,
                          0,
                          NULL,
                          return_md,
                          NULL,
                          att_id,
                          NULL,
                          RETURNVAR,
                          NULL,
                          TEMPORARY
                          );
/*
 * Return output grid and attributes to NCL.
 */
  return_data.kind = NclStk_VAR;
  return_data.u.data_var = tmp_var;
  _NclPlaceReturn(return_data);
  return(NhlNOERROR);

}
Пример #3
0
NhlErrorTypes wavelet_W( void )
{
/*
 * Input array variables
 */
  void *y, *dt, *param, *s0, *dj, *siglvl, *nadof;
  int *mother, *jtot, *npad, *noise, *isigtest;
  double *tmp_y, *tmp_dt, *tmp_param, *tmp_s0, *tmp_dj;
  double *tmp_siglvl, tmp_nadof[2];
  ng_size_t dsizes_y[NCL_MAX_DIMENSIONS];
  NclBasicDataTypes type_y, type_dt, type_param, type_s0, type_dj;
  NclBasicDataTypes type_siglvl;
/*
 * Attribute variables
 */
  int att_id;
  ng_size_t dsizes[NCL_MAX_DIMENSIONS];
  NclMultiDValData att_md, return_md;
  NclVar tmp_var;
  NclStackEntry return_data;
/*
 * Output array variables
 */
  void *wave, *scale, *period, *coi, *dof, *ffttheor, *signif, *gws;
  void *power, *phase, *r1, *mean, *st_dev, *lag1, *cdelta, *psi0;
  double *tmp_wave, *tmp_scale, *tmp_period, *tmp_coi, *tmp_dof; 
  double *tmp_ffttheor, *tmp_signif, *tmp_gws, *tmp_power, *tmp_phase;
  double *tmp_r1;
  double *tmp_mean, *tmp_st_dev, *tmp_lag1, *tmp_cdelta, *tmp_psi0;
  int ndims_wave = 3;
  ng_size_t dsizes_wave[3]; 
  NclBasicDataTypes type_wave;
  NclObjClass type_output;
/*
 * Declare various variables for random purposes.
 */
  ng_size_t n, size_wave, size_output; 
  int in;
/*
 * Retrieve parameters
 *
 * Note that any of the pointer parameters can be set to NULL,
 * which implies you don't care about its value.
 *
 * Retrieve argument #1
 */
  y = (void*)NclGetArgValue(
          0,
          12,
          NULL,
          dsizes_y,
          NULL,
          NULL,
          &type_y,
          DONT_CARE);

  mother = (int*)NclGetArgValue(
          1,
          12,
          NULL,
          NULL,
          NULL,
          NULL,
          NULL,
          DONT_CARE);

  dt = (void*)NclGetArgValue(
          2,
          12,
          NULL,
          NULL,
          NULL,
          NULL,
          &type_dt,
          DONT_CARE);

  param = (void*)NclGetArgValue(
          3,
          12,
          NULL,
          NULL,
          NULL,
          NULL,
          &type_param,
          DONT_CARE);

  s0 = (void*)NclGetArgValue(
          4,
          12,
          NULL,
          NULL,
          NULL,
          NULL,
          &type_s0,
          DONT_CARE);

  dj = (void*)NclGetArgValue(
          5,
          12,
          NULL,
          NULL,
          NULL,
          NULL,
          &type_dj,
          DONT_CARE);

  jtot = (int*)NclGetArgValue(
          6,
          12,
          NULL,
          NULL,
          NULL,
          NULL,
          NULL,
          DONT_CARE);

  npad = (int*)NclGetArgValue(
          7,
          12,
          NULL,
          NULL,
          NULL,
          NULL,
          NULL,
          DONT_CARE);

  noise = (int*)NclGetArgValue(
          8,
          12,
          NULL,
          NULL,
          NULL,
          NULL,
          NULL,
          DONT_CARE);

  isigtest = (int*)NclGetArgValue(
          9,
          12,
          NULL,
          NULL,
          NULL,
          NULL,
          NULL,
          DONT_CARE);

  siglvl = (void*)NclGetArgValue(
          10,
          12,
          NULL,
          NULL,
          NULL,
          NULL,
          &type_siglvl,
          DONT_CARE);

/*
 * nadof is ignored for now.  We'll create a dummy nadof variable and pass
 * that to the wavelet function.
 */
  nadof = (void*)NclGetArgValue(
          11,
          12,
          NULL,
          NULL,
          NULL,
          NULL,
          NULL,
          DONT_CARE);
/*
 * We haven't implemented isigtest = 2, so default to 0 if it isn't.
 */
  if(*isigtest != 0 && *isigtest != 1) {
    NhlPError(NhlWARNING,NhlEUNKNOWN,"wavelet: Only isigtest = 0 or 1 has been implemented. Defaulting to 0");
    *isigtest = 0;
  }

/*
 * Get size of input array.
 */
  n = dsizes_y[0];
  if(n > INT_MAX)  {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"wavelet: n = %ld is greater than INT_MAX", n);
    return(NhlFATAL);
  }
  in = (int) n;
/*
 * Coerce input if necessary.
 */
  tmp_y      = coerce_input_double(y,type_y,n,0,NULL,NULL);
  tmp_dt     = coerce_input_double(dt,type_dt,1,0,NULL,NULL);
  tmp_param  = coerce_input_double(param,type_param,1,0,NULL,NULL);
  tmp_s0     = coerce_input_double(s0,type_s0,1,0,NULL,NULL);
  tmp_dj     = coerce_input_double(dj,type_dj,1,0,NULL,NULL);
  tmp_siglvl = coerce_input_double(siglvl,type_siglvl,1,0,NULL,NULL);

  if(  tmp_y    == NULL || tmp_dt == NULL ||  tmp_param == NULL || 
       tmp_s0    == NULL || tmp_dj == NULL || tmp_siglvl == NULL) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"wavelet: Unable to coerce input to double precision");
    return(NhlFATAL);
  }

/*
 * Allocate space for output array and attributes.
 *
 * Also, set size for output array (wave).
 */
  dsizes_wave[0] = 2;
  dsizes_wave[1] = *jtot;
  dsizes_wave[2] = n;
  size_wave = *jtot * 2 * n;

  if(type_y == NCL_double) {
    type_wave   = NCL_double;
    type_output = nclTypedoubleClass;
    size_output = sizeof(double);
  }
  else {
    type_wave   = NCL_float;
    type_output = nclTypefloatClass;
    size_output = sizeof(float);
  }
  wave     = (void*)calloc(size_wave,size_output);
  scale    = (void*)calloc(*jtot,size_output);
  period   = (void*)calloc(*jtot,size_output);
  coi      = (void*)calloc(n,size_output);
  dof      = (void*)calloc(*jtot,size_output);
  ffttheor = (void*)calloc(*jtot,size_output);
  signif   = (void*)calloc(*jtot,size_output);
  gws      = (void*)calloc(*jtot,size_output);
  power    = (void*)calloc(*jtot*n,size_output);
  phase    = (void*)calloc(*jtot*n,size_output);
  r1       = (void*)calloc(1,size_output);
  mean     = (void*)calloc(1,size_output);
  st_dev   = (void*)calloc(1,size_output);
  lag1     = (void*)calloc(1,size_output);
  cdelta   = (void*)calloc(1,size_output);
  psi0     = (void*)calloc(1,size_output);

  tmp_wave     = coerce_output_double(wave,type_wave,size_wave);
  tmp_scale    = coerce_output_double(scale,type_wave,*jtot);
  tmp_period   = coerce_output_double(period,type_wave,*jtot);
  tmp_coi      = coerce_output_double(coi,type_wave,n);
  tmp_dof      = coerce_output_double(dof,type_wave,*jtot);
  tmp_ffttheor = coerce_output_double(ffttheor,type_wave,*jtot);
  tmp_signif   = coerce_output_double(signif,type_wave,*jtot);
  tmp_gws      = coerce_output_double(gws,type_wave,*jtot);
  tmp_power    = coerce_output_double(power,type_wave,*jtot*n);
  tmp_phase    = coerce_output_double(phase,type_wave,*jtot*n);
  tmp_r1       = coerce_output_double(r1,type_wave,1);
  tmp_mean     = coerce_output_double(mean,type_wave,1);
  tmp_st_dev   = coerce_output_double(st_dev,type_wave,1);
  tmp_lag1     = coerce_output_double(lag1,type_wave,1);
  tmp_cdelta   = coerce_output_double(cdelta,type_wave,1);
  tmp_psi0     = coerce_output_double(psi0,type_wave,1);
      
  if(   tmp_wave == NULL || tmp_scale == NULL ||   tmp_period == NULL || 
         tmp_coi == NULL ||   tmp_dof == NULL || tmp_ffttheor == NULL ||
      tmp_signif == NULL ||   tmp_gws == NULL ||     tmp_mean == NULL ||
       tmp_power == NULL || tmp_phase == NULL ||   tmp_st_dev == NULL ||
        tmp_lag1 == NULL ||tmp_cdelta == NULL ||     tmp_psi0 == NULL ||
          tmp_r1 == NULL) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"wavelet: Unable to allocate memory for output variables");
    return(NhlFATAL);
  }
/*
 * Call the Fortran routine.
 */
  NGCALLF(waveleti,WAVELETI)(&in,tmp_y,tmp_dt,mother,tmp_param,tmp_s0,tmp_dj,
                             jtot,npad,noise,isigtest,tmp_siglvl,tmp_nadof,
                             tmp_wave,tmp_scale,tmp_period,tmp_coi,tmp_dof,
                             tmp_ffttheor,tmp_signif,tmp_gws,tmp_mean,
                             tmp_st_dev,tmp_lag1,tmp_cdelta,tmp_psi0,
                             tmp_power,tmp_phase,tmp_r1);

  if(type_wave == NCL_float) {
    coerce_output_float_only(wave,tmp_wave,size_wave,0);
    coerce_output_float_only(scale,tmp_scale,*jtot,0);
    coerce_output_float_only(period,tmp_period,*jtot,0);
    coerce_output_float_only(coi,tmp_coi,n,0);
    coerce_output_float_only(dof,tmp_dof,*jtot,0);
    coerce_output_float_only(ffttheor,tmp_ffttheor,*jtot,0);
    coerce_output_float_only(signif,tmp_signif,*jtot,0);
    coerce_output_float_only(gws,tmp_gws,*jtot,0);
    coerce_output_float_only(power,tmp_power,*jtot*n,0);
    coerce_output_float_only(phase,tmp_phase,*jtot*n,0);
    coerce_output_float_only(r1,tmp_r1,1,0);
    coerce_output_float_only(mean,tmp_mean,1,0);
    coerce_output_float_only(st_dev,tmp_st_dev,1,0);
    coerce_output_float_only(lag1,tmp_lag1,1,0);
    coerce_output_float_only(cdelta,tmp_cdelta,1,0);
    coerce_output_float_only(psi0,tmp_psi0,1,0);
  }
/*
 * Free memory.
 */
  if(type_y        != NCL_double) NclFree(tmp_y);
  if(type_dt       != NCL_double) NclFree(tmp_dt);
  if(type_param    != NCL_double) NclFree(tmp_param);
  if(type_s0       != NCL_double) NclFree(tmp_s0);
  if(type_dj       != NCL_double) NclFree(tmp_dj);
  if(type_siglvl   != NCL_double) NclFree(tmp_siglvl);

  if(type_wave != NCL_double) {
    NclFree(tmp_wave);
    NclFree(tmp_scale);
    NclFree(tmp_period);
    NclFree(tmp_coi);
    NclFree(tmp_dof);
    NclFree(tmp_ffttheor);
    NclFree(tmp_signif);
    NclFree(tmp_gws);
    NclFree(tmp_power);
    NclFree(tmp_phase);
    NclFree(tmp_r1);
    NclFree(tmp_mean);
    NclFree(tmp_st_dev);
    NclFree(tmp_lag1);
    NclFree(tmp_cdelta);
    NclFree(tmp_psi0);
  }
/*
 * Set up variable to return.
 */
  return_md = _NclCreateVal(
                            NULL,
                            NULL,
                            Ncl_MultiDValData,
                            0,
                            wave,
                            NULL,
                            ndims_wave,
                            dsizes_wave,
                            TEMPORARY,
                            NULL,
                            type_output
                            );
/*
 * Set up attributes to return.
 */
  att_id = _NclAttCreate(NULL,NULL,Ncl_Att,0,NULL);

  dsizes[0] = *jtot;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         scale,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "scale",
             att_md,
             NULL
             );

  dsizes[0] = *jtot;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         period,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "period",
             att_md,
             NULL
             );

  dsizes[0] = n;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         coi,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "coi",
             att_md,
             NULL
             );


  dsizes[0] = *jtot;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         dof,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "dof",
             att_md,
             NULL
             );

  dsizes[0] = *jtot;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         ffttheor,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "fft_theor",
             att_md,
             NULL
             );

  dsizes[0] = *jtot;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         signif,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "signif",
             att_md,
             NULL
             );
  
  dsizes[0] = *jtot;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         gws,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "gws",
             att_md,
             NULL
             );
  
  dsizes[0] = *jtot*n;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         power,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "power",
             att_md,
             NULL
             );

  dsizes[0] = *jtot*n;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         phase,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "phase",
             att_md,
             NULL
             );

  dsizes[0] = 1;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         r1,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "r1",
             att_md,
             NULL
             );

  dsizes[0] = 1;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         mean,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "mean",
             att_md,
             NULL
             );

  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         st_dev,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "stdev",
             att_md,
             NULL
             );

  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         lag1,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "lag1",
             att_md,
             NULL
             );

  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         cdelta,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "cdelta",
             att_md,
             NULL
             );

  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         psi0,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "psi0",
             att_md,
             NULL
             );

  tmp_var = _NclVarCreate(
                          NULL,
                          NULL,
                          Ncl_Var,
                          0,
                          NULL,
                          return_md,
                          NULL,
                          att_id,
                          NULL,
                          RETURNVAR,
                          NULL,
                          TEMPORARY
                          );
/*
 * Return output grid and attributes to NCL.
 */
  return_data.kind = NclStk_VAR;
  return_data.u.data_var = tmp_var;
  _NclPlaceReturn(return_data);
  return(NhlNOERROR);
}
Пример #4
0
NhlErrorTypes wavelet_default_W( void )
{
/*
 * Input array variables
 */
  void *y;
  int *mother, jtot, npad, noise, isigtest;
  double *tmp_y, dt, param, s0, dj, siglvl, nadof[2];
  ng_size_t dsizes_y[NCL_MAX_DIMENSIONS];
  NclBasicDataTypes type_y;
/*
 * Attribute variables
 */
  int att_id;
  ng_size_t dsizes[NCL_MAX_DIMENSIONS];
  NclMultiDValData att_md, return_md;
  NclVar tmp_var;
  NclStackEntry return_data;
/*
 * Output array variables
 */
  void *wave, *scale, *period, *coi, *dof, *ffttheor, *signif, *gws;
  void *power, *phase, *r1, *mean, *st_dev, *lag1, *cdelta, *psi0;
  double *tmp_wave, *tmp_scale, *tmp_period, *tmp_coi, *tmp_dof; 
  double *tmp_ffttheor, *tmp_signif, *tmp_gws, *tmp_power, *tmp_phase;
  double *tmp_r1;
  double *tmp_mean, *tmp_st_dev, *tmp_lag1, *tmp_cdelta, *tmp_psi0;
  int ndims_wave = 3;
  ng_size_t dsizes_wave[3]; 
  NclBasicDataTypes type_wave;
  NclObjClass type_output;
/*
 * Declare various variables for random purposes.
 */
  ng_size_t n, size_wave, size_output; 
  int in;
/*
 * Retrieve parameters
 *
 * Note that any of the pointer parameters can be set to NULL,
 * which implies you don't care about its value.
 *
 * Retrieve argument #1
 */
  y = (void*)NclGetArgValue(
          0,
          2,
          NULL,
          dsizes_y,
          NULL,
          NULL,
          &type_y,
          DONT_CARE);

  mother = (int*)NclGetArgValue(
          1,
          2,
          NULL,
          NULL,
          NULL,
          NULL,
          NULL,
          DONT_CARE);

/*
 * Get size of input array.
 */
  n = dsizes_y[0];

  if(n > INT_MAX)  {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"wavelet_default: n = %ld is greater than INT_MAX", n);
    return(NhlFATAL);
  }
  in = (int) n;

/*
 * Initialize.
 */
  if (*mother <= 0 || *mother > 2) {
    param = 6.0;
  }
  else if (*mother == 1) {
    param = 4.0;
  }
  else if (*mother == 2) {
    param = 2.0;
  }

  dt       = 1.0;
  s0       = 2.*dt;
  dj       = 0.25;
  jtot     = 1 + ((log(n*dt/s0))/dj)/log(2.);
  npad     = n;
  noise    = 1;
  isigtest = 0;
  siglvl   = 0.05;
  
/*
 * Coerce input if necessary.
 */
  tmp_y      = coerce_input_double(y,type_y,n,0,NULL,NULL);

  if( tmp_y == NULL) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"wavelet_default: Unable to coerce input to double precision");
    return(NhlFATAL);
  }

/*
 * Allocate space for output array and attributes.
 *
 * Also, set size for output array (wave).
 */
  dsizes_wave[0] = 2;
  dsizes_wave[1] = jtot;
  dsizes_wave[2] = n;
  size_wave = jtot * 2 * n;

  if(type_y == NCL_double) {
    type_wave   = NCL_double;
    type_output = nclTypedoubleClass;
    size_output = sizeof(double);
  }
  else {
    type_wave   = NCL_float;
    type_output = nclTypefloatClass;
    size_output = sizeof(float);
  }
  wave     = (void*)calloc(size_wave,size_output);
  scale    = (void*)calloc(jtot,size_output);
  period   = (void*)calloc(jtot,size_output);
  coi      = (void*)calloc(n,size_output);
  dof      = (void*)calloc(jtot,size_output);
  ffttheor = (void*)calloc(jtot,size_output);
  signif   = (void*)calloc(jtot,size_output);
  gws      = (void*)calloc(jtot,size_output);
  power    = (void*)calloc(jtot*n,size_output);
  phase    = (void*)calloc(jtot*n,size_output);
  r1       = (void*)calloc(1,size_output);
  mean     = (void*)calloc(1,size_output);
  st_dev   = (void*)calloc(1,size_output);
  lag1     = (void*)calloc(1,size_output);
  cdelta   = (void*)calloc(1,size_output);
  psi0     = (void*)calloc(1,size_output);

  tmp_wave     = coerce_output_double(wave,type_wave,size_wave);
  tmp_scale    = coerce_output_double(scale,type_wave,jtot);
  tmp_period   = coerce_output_double(period,type_wave,jtot);
  tmp_coi      = coerce_output_double(coi,type_wave,n);
  tmp_dof      = coerce_output_double(dof,type_wave,jtot);
  tmp_ffttheor = coerce_output_double(ffttheor,type_wave,jtot);
  tmp_signif   = coerce_output_double(signif,type_wave,jtot);
  tmp_gws      = coerce_output_double(gws,type_wave,jtot);
  tmp_power    = coerce_output_double(power,type_wave,jtot*n);
  tmp_phase    = coerce_output_double(phase,type_wave,jtot*n);
  tmp_r1       = coerce_output_double(r1,type_wave,1);
  tmp_mean     = coerce_output_double(mean,type_wave,1);
  tmp_st_dev   = coerce_output_double(st_dev,type_wave,1);
  tmp_lag1     = coerce_output_double(lag1,type_wave,1);
  tmp_cdelta   = coerce_output_double(cdelta,type_wave,1);
  tmp_psi0     = coerce_output_double(psi0,type_wave,1);
      
  if(   tmp_wave == NULL || tmp_scale == NULL ||   tmp_period == NULL || 
         tmp_coi == NULL ||   tmp_dof == NULL || tmp_ffttheor == NULL ||
      tmp_signif == NULL ||   tmp_gws == NULL ||     tmp_mean == NULL ||
       tmp_power == NULL || tmp_phase == NULL ||   tmp_st_dev == NULL ||
        tmp_lag1 == NULL ||tmp_cdelta == NULL ||     tmp_psi0 == NULL ||
          tmp_r1 == NULL) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"wavelet_default: Unable to allocate memory for output variables");
    return(NhlFATAL);
  }
/*
 * Call the Fortran routine.
 */
  NGCALLF(waveleti,WAVELETI)(&in,tmp_y,&dt,mother,&param,&s0,&dj,
                             &jtot,&npad,&noise,&isigtest,&siglvl,nadof,
                             tmp_wave,tmp_scale,tmp_period,tmp_coi,tmp_dof,
                             tmp_ffttheor,tmp_signif,tmp_gws,tmp_mean,
                             tmp_st_dev,tmp_lag1,tmp_cdelta,tmp_psi0,
                             tmp_power,tmp_phase,tmp_r1);

  if(type_wave == NCL_float) {
    coerce_output_float_only(wave,tmp_wave,size_wave,0);
    coerce_output_float_only(scale,tmp_scale,jtot,0);
    coerce_output_float_only(period,tmp_period,jtot,0);
    coerce_output_float_only(coi,tmp_coi,n,0);
    coerce_output_float_only(dof,tmp_dof,jtot,0);
    coerce_output_float_only(ffttheor,tmp_ffttheor,jtot,0);
    coerce_output_float_only(signif,tmp_signif,jtot,0);
    coerce_output_float_only(gws,tmp_gws,jtot,0);
    coerce_output_float_only(power,tmp_power,jtot*n,0);
    coerce_output_float_only(phase,tmp_phase,jtot*n,0);
    coerce_output_float_only(r1,tmp_r1,1,0);
    coerce_output_float_only(mean,tmp_mean,1,0);
    coerce_output_float_only(st_dev,tmp_st_dev,1,0);
    coerce_output_float_only(lag1,tmp_lag1,1,0);
    coerce_output_float_only(cdelta,tmp_cdelta,1,0);
    coerce_output_float_only(psi0,tmp_psi0,1,0);
  }
/*
 * Free memory.
 */
  if(type_y != NCL_double) NclFree(tmp_y);

  if(type_wave != NCL_double) {
    NclFree(tmp_wave);
    NclFree(tmp_scale);
    NclFree(tmp_period);
    NclFree(tmp_coi);
    NclFree(tmp_dof);
    NclFree(tmp_ffttheor);
    NclFree(tmp_signif);
    NclFree(tmp_gws);
    NclFree(tmp_power);
    NclFree(tmp_phase);
    NclFree(tmp_r1);
    NclFree(tmp_mean);
    NclFree(tmp_st_dev);
    NclFree(tmp_lag1);
    NclFree(tmp_cdelta);
    NclFree(tmp_psi0);
  }
/*
 * Set up variable to return.
 */
  return_md = _NclCreateVal(
                            NULL,
                            NULL,
                            Ncl_MultiDValData,
                            0,
                            wave,
                            NULL,
                            ndims_wave,
                            dsizes_wave,
                            TEMPORARY,
                            NULL,
                            type_output
                            );
/*
 * Set up attributes to return.
 */
  att_id = _NclAttCreate(NULL,NULL,Ncl_Att,0,NULL);

  dsizes[0] = jtot;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         scale,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "scale",
             att_md,
             NULL
             );

  dsizes[0] = jtot;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         period,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "period",
             att_md,
             NULL
             );

  dsizes[0] = n;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         coi,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "coi",
             att_md,
             NULL
             );


  dsizes[0] = jtot;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         dof,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "dof",
             att_md,
             NULL
             );

  dsizes[0] = jtot;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         ffttheor,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "fft_theor",
             att_md,
             NULL
             );

  dsizes[0] = jtot;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         signif,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "signif",
             att_md,
             NULL
             );
  
  dsizes[0] = jtot;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         gws,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "gws",
             att_md,
             NULL
             );
  
  dsizes[0] = jtot*n;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         power,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "power",
             att_md,
             NULL
             );

  dsizes[0] = jtot*n;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         phase,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "phase",
             att_md,
             NULL
             );

  dsizes[0] = 1;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         r1,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "r1",
             att_md,
             NULL
             );

  dsizes[0] = 1;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         mean,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "mean",
             att_md,
             NULL
             );

  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         st_dev,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "stdev",
             att_md,
             NULL
             );

  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         lag1,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "lag1",
             att_md,
             NULL
             );

  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         cdelta,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "cdelta",
             att_md,
             NULL
             );

  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         psi0,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "psi0",
             att_md,
             NULL
             );

  tmp_var = _NclVarCreate(
                          NULL,
                          NULL,
                          Ncl_Var,
                          0,
                          NULL,
                          return_md,
                          NULL,
                          att_id,
                          NULL,
                          RETURNVAR,
                          NULL,
                          TEMPORARY
                          );
/*
 * Return output grid and attributes to NCL.
 */
  return_data.kind = NclStk_VAR;
  return_data.u.data_var = tmp_var;
  _NclPlaceReturn(return_data);
  return(NhlNOERROR);
}
Пример #5
0
NhlErrorTypes covcorm_W( void )
{
/*
 * Input array variables
 */
  void *x, *trace;
  int *iopt;
  double *dx, *dtrace;
  ng_size_t dsizes_x[NCL_MAX_DIMENSIONS];
  int ndims_x, has_missing_x;
  NclScalar missing_x, missing_dx;
  ng_size_t size_x, nvar, ntim, lvcm;
  int ier;
  NclBasicDataTypes type_x;

/*
 * Output array variable
 */
  void  *vcm;
  double *dvcm;
  ng_size_t *dsizes_vcm;
  int ndims_vcm;
  ng_size_t size_vcm;
  NclBasicDataTypes type_vcm;
  NclTypeClass type_vcm_class;
  NclScalar missing_vcm;

/*
 * Variables for returning attributes.
 */
  int att_id;
  ng_size_t dsizes[1];
  NclMultiDValData att_md, return_md;
  NclVar tmp_var;
  NclStackEntry return_data;

  int intim, invar, ilvcm;

/*
 * Retrieve x.
 */
  x = (void*)NclGetArgValue(
          0,
          2,
          &ndims_x,
          dsizes_x,
          &missing_x,
          &has_missing_x,
          &type_x,
          DONT_CARE);

  iopt = (int*)NclGetArgValue(
          1,
          2,
          NULL,
          NULL,
          NULL,
          NULL,
          NULL,
          DONT_CARE);

  nvar = dsizes_x[0];
  ntim = dsizes_x[1];
  size_x = nvar * ntim;
  lvcm = (nvar*(nvar+1))/2;

/*
 * Test dimension sizes to make sure they are <= INT_MAX.
 */
  if((ntim > INT_MAX) ||
     (nvar > INT_MAX) ||
     (lvcm > INT_MAX)) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"covcorm: one or more dimension sizes are greater than INT_MAX");
    return(NhlFATAL);
  }
  intim = (int) ntim;
  invar = (int) nvar;
  ilvcm = (int) lvcm;

/*
 * Coerce missing values, if any.
 */
  coerce_missing(type_x,has_missing_x,&missing_x,&missing_dx,NULL);

/*
 * Allocate space for input/output arrays.
 */
  if(!iopt[1]) {
    size_vcm      = lvcm;
    ndims_vcm     = 1;
    dsizes_vcm    = (ng_size_t*)malloc(sizeof(ng_size_t));
    dsizes_vcm[0] = size_vcm;
  }
  else {
    size_vcm      = nvar*nvar;
    ndims_vcm     = 2;
    dsizes_vcm    = (ng_size_t*)malloc(2*sizeof(ng_size_t));
    dsizes_vcm[0] = nvar;
    dsizes_vcm[1] = nvar;
  }
  dx = coerce_input_double(x,type_x,size_x,0,NULL,NULL);

  if(type_x == NCL_double) {
    type_vcm              = NCL_double;
    vcm                   = (void*)malloc(size_vcm*sizeof(double));
    trace                 = (void*)malloc(sizeof(double));
    if(vcm == NULL || trace == NULL ) {
      NhlPError(NhlFATAL,NhlEUNKNOWN,"covcorm: Unable to allocate memory for output array");
      return(NhlFATAL);
    }
    dvcm                  = &((double*)vcm)[0];
    dtrace                = &((double*)trace)[0];
    missing_vcm.doubleval = missing_dx.doubleval;
  }
  else {
    type_vcm             = NCL_float;
    vcm                  = (void*)malloc(size_vcm*sizeof(float));
    trace                = (void*)malloc(sizeof(float));
    dvcm                 = (double*)malloc(size_vcm*sizeof(double));
    dtrace               = (double*)malloc(sizeof(double));
    missing_vcm.floatval = (float)missing_dx.doubleval;
    if(vcm == NULL || trace == NULL  || dvcm == NULL || dtrace == NULL ) {
      NhlPError(NhlFATAL,NhlEUNKNOWN,"covcorm: Unable to allocate memory for output array");
      return(NhlFATAL);
    }
  }


/*
 * Depending on iopt[1], call one of two Fortran routines.
 *    iopt[0]=0 --> covariance
 *    iopt[0]=1 --> correlation 
 *    iopt[1]=0 --> 1D array (symmetric storage)
 *    iopt[1]=1 --> 2D array
 */
  if(!iopt[1]) {
    NGCALLF(dcovcormssm,DCOVCORMSSM)(&intim,&invar,dx,&missing_dx.doubleval,
                                     &iopt[0],dvcm,&ilvcm,dtrace,&ier);
  }
  else {
    NGCALLF(dcovcorm,DCOVCORM)(&intim,&invar,dx,&missing_dx.doubleval,
                               &iopt[0],dvcm,&ilvcm,dtrace,&ier);
  }

  if(type_vcm == NCL_float) {
/*
 * Need to coerce output array back to float before we return it.
 */
    coerce_output_float_only(vcm,dvcm,size_vcm,0);
    coerce_output_float_only(trace,dtrace,1,0);

    NclFree(dx);
    if(type_x != NCL_double) NclFree(dvcm);
    NclFree(dtrace);
  }


/*
 * Set up return value.
 */
  type_vcm_class = (NclTypeClass)(_NclNameToTypeClass(NrmStringToQuark(_NclBasicDataTypeToName(type_vcm))));
  return_md = _NclCreateVal(
                            NULL,
                            NULL,
                            Ncl_MultiDValData,
                            0,
                            vcm,
                            &missing_vcm,
                            ndims_vcm,
                            dsizes_vcm,
                            TEMPORARY,
                            NULL,
                            (NclObjClass)type_vcm_class
                            );

/*
 * Initialize att_id so we can return some attributes.
 */
  att_id = _NclAttCreate(NULL,NULL,Ncl_Att,0,NULL);

  dsizes[0] = 1;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         trace,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         (NclObjClass)type_vcm_class
                         );
  _NclAddAtt(
             att_id,
             "trace",
             att_md,
             NULL
             );

  tmp_var = _NclVarCreate(
                          NULL,
                          NULL,
                          Ncl_Var,
                          0,
                          NULL,
                          return_md,
                          NULL,
                          att_id,
                          NULL,
                          RETURNVAR,
                          NULL,
                          TEMPORARY
                          );
/*
 * Return output grid and attributes to NCL.
 */
  return_data.kind = NclStk_VAR;
  return_data.u.data_var = tmp_var;
  _NclPlaceReturn(return_data);
  return(NhlNOERROR);

}
Пример #6
0
NhlErrorTypes ezfftf_W( void )
{
/*
 * Input array variables
 */
  void *x;
  int ndims_x;
  ng_size_t dsizes_x[NCL_MAX_DIMENSIONS];
  NclBasicDataTypes type_x;
  NclScalar missing_x, missing_dx, missing_rx, missing_cf;
  int has_missing_x;
  double *tmp_x = NULL;
/*
 * Output array variables
 */
  void *cf, *xbar;
  int ndims_cf;
  ng_size_t dsizes_cf[NCL_MAX_DIMENSIONS];
  double *tmp_cf1, *tmp_cf2, *tmp_xbar;
  NclBasicDataTypes type_cf;
  NclTypeClass type_cf_class;
/*
 * Attribute variables
 */
  void *N;
  int att_id;
  ng_size_t dsizes[1];
  NclMultiDValData att_md, return_md;
  NclVar tmp_var;
  NclStackEntry return_data;
/*
 * various
 */
  double *work;
  ng_size_t index_x, index_cf1, index_cf2;
  ng_size_t i, npts, npts2, lnpts2, npts22;
  int found_missing, any_missing;
  ng_size_t size_leftmost, size_cf;
  int inpts;

/*
 * Retrieve parameters
 *
 * Note any of the pointer parameters can be set to NULL, which
 * implies you don't care about its value.
 */
  x = (void*)NclGetArgValue(
           0,
           1,
           &ndims_x, 
           dsizes_x,
           &missing_x,
           &has_missing_x,
           &type_x,
           DONT_CARE);
/*
 * Calculate number of leftmost elements.
 */
  size_leftmost = 1;
  for( i = 0; i < ndims_x-1; i++ ) size_leftmost *= dsizes_x[i];
/*
 * Test input array size
 */
  npts = dsizes_x[ndims_x-1];

  if(npts > INT_MAX) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"ezfftf: npts = %d is greater than INT_MAX", npts);
    return(NhlFATAL);
  }
  inpts = (int) npts;

/*
 * Calculate size of output array.
 */
  if((npts % 2) == 0) {
    npts2 = npts/2;
  }
  else {
    npts2 = (npts-1)/2;
  }
  lnpts2 = npts2 * size_leftmost;
  npts22 = 2*npts2;
  size_cf = size_leftmost * npts22;

  ndims_cf           = ndims_x + 1;
  dsizes_cf[0]       = 2;
  for(i = 1; i < ndims_x; i++ ) dsizes_cf[i] = dsizes_x[i-1];
  dsizes_cf[ndims_x] = npts2;
/*
 * Coerce missing values.
 */
  coerce_missing(type_x,has_missing_x,&missing_x,&missing_dx,&missing_rx);
/*
 * Create space for temporary input array if necessary.
 */
  if(type_x != NCL_double) {
    tmp_x = (double*)calloc(npts,sizeof(double));
    if(tmp_x == NULL) {
      NhlPError(NhlFATAL,NhlEUNKNOWN,"ezfftf: Unable to allocate memory for coercing input array to double precision");
      return(NhlFATAL);
    }
  }
/*
 * Allocate space for output arrays.
 */
  tmp_xbar = (double*)calloc(1,sizeof(double));
  tmp_cf1  = (double*)calloc(npts2,sizeof(double));
  tmp_cf2  = (double*)calloc(npts2,sizeof(double));
  if ( tmp_cf1 == NULL || tmp_cf2 == NULL || tmp_xbar == NULL ) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"ezfftf: Cannot allocate memory for temporary output arrays" );
    return(NhlFATAL);
  }
  if(type_x == NCL_double) {
    cf   = (void*)calloc(size_cf,sizeof(double));
    xbar = (void*)calloc(size_leftmost,sizeof(double));
    type_cf = NCL_double;
    if(has_missing_x) missing_cf = missing_dx;
  }
  else {
    cf   = (void*)calloc(size_cf,sizeof(float));
    xbar = (void*)calloc(size_leftmost,sizeof(float));
    type_cf = NCL_float;
    if(has_missing_x) missing_cf = missing_rx;
  }
  N = (void*)calloc(1,sizeof(int));
  if ( cf == NULL || xbar == NULL || N == NULL ) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"ezfftf: Cannot allocate memory for output arrays" );
    return(NhlFATAL);
  }

/*
 * Allocate memory for work array
 */
  work = (double*)calloc((4*npts+15),sizeof(double));
  if ( work == NULL ) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"ezfftf: Cannot allocate memory for work array" );
    return(NhlFATAL);
  }
/*
 * Call the f77 version of 'dezfftf' with the full argument list.
 */
  index_x   = 0;
  index_cf1 = 0;
  index_cf2 = lnpts2;
  any_missing = 0;
  for(i = 0; i < size_leftmost; i++) {
    if(type_x != NCL_double) { 
      coerce_subset_input_double(x,tmp_x,index_x,type_x,npts,0,NULL,NULL);
    }
    else {
      tmp_x = &((double*)x)[index_x];
    }
/*
 * Check for missing values in x.  If any, then coerce that section of
 * the output to missing.
 */
    found_missing = contains_missing(tmp_x,npts,has_missing_x,
                                     missing_dx.doubleval);
    if(found_missing) {
      any_missing++;
      set_subset_output_missing(xbar,i,type_cf,1,missing_dx.doubleval);
      set_subset_output_missing(cf,index_cf1,type_cf,npts2,
                                missing_dx.doubleval);
      set_subset_output_missing(cf,index_cf2,type_cf,npts2,
                                missing_dx.doubleval);
    }
    else {
      NGCALLF(dezffti,DEZFFTI)(&inpts,work);
      NGCALLF(dezfftf,DEZFFTF)(&inpts,tmp_x,tmp_xbar,tmp_cf1,tmp_cf2,work);
/*
 * Copy results back into xbar and cf.
 */
      coerce_output_float_or_double(xbar,tmp_xbar,type_cf,1,i);
      coerce_output_float_or_double(cf,tmp_cf1,type_cf,npts2,index_cf1);
      coerce_output_float_or_double(cf,tmp_cf2,type_cf,npts2,index_cf2);
    }
    index_x   += npts;
    index_cf1 += npts2;
    index_cf2 += npts2;
  }

/*
 * Free up memory.
 */
  if(type_x != NCL_double) free(tmp_x);
  free(work);
  free(tmp_cf1);
  free(tmp_cf2);
  free(tmp_xbar);
/*
 * Set up variable to return.
 */
  type_cf_class = (NclTypeClass)_NclNameToTypeClass(NrmStringToQuark(_NclBasicDataTypeToName(type_cf)));

/*
 * Set up return values.
 */
  if(any_missing) {
    NhlPError(NhlWARNING,NhlEUNKNOWN,"ezfftf: %d input arrays contained missing values. No calculations performed on these arrays.",any_missing);

    return_md = _NclCreateVal(
                              NULL,
                              NULL,
                              Ncl_MultiDValData,
                              0,
                              cf,
                              &missing_cf,
                              ndims_cf,
                              dsizes_cf,
                              TEMPORARY,
                              NULL,
                              (NclObjClass)type_cf_class
                              );
  }
  else {
    return_md = _NclCreateVal(
                              NULL,
                              NULL,
                              Ncl_MultiDValData,
                              0,
                              cf,
                              NULL,
                              ndims_cf,
                              dsizes_cf,
                              TEMPORARY,
                              NULL,
                              (NclObjClass)type_cf_class
                              );
  }
/*
 * Attributes "xbar" and "npts".
 */
  att_id = _NclAttCreate(NULL,NULL,Ncl_Att,0,NULL);

  dsizes[0] = size_leftmost;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         xbar,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         (NclObjClass)type_cf_class
                         );
  _NclAddAtt(
             att_id,
             "xbar",
             att_md,
             NULL
             );

  (*(int*)N) = npts;
  dsizes[0] = 1;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         N,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         (NclObjClass)nclTypeintClass
                         );
  _NclAddAtt(
             att_id,
             "npts",
             att_md,
             NULL
             );

/*
 * Set up variable to hold return array and attributes.
 */
  tmp_var = _NclVarCreate(
                          NULL,
                          NULL,
                          Ncl_Var,
                          0,
                          NULL,
                          return_md,
                          NULL,
                          att_id,
                          NULL,
                          RETURNVAR,
                          NULL,
                          TEMPORARY
                          );
/*
 * Return output grid and attributes to NCL.
 */
  return_data.kind = NclStk_VAR;
  return_data.u.data_var = tmp_var;
  _NclPlaceReturn(return_data);
  return(NhlNOERROR);
}
Пример #7
0
NhlErrorTypes fft2df_W( void )
{
/*
 * First and only input argument.
 */
  void *x;
  double *tmp_x, *tmp_r;
  ng_size_t dsizes_x[2];
  NclBasicDataTypes type_x;

/*
 * Return variable
 */
  void *coef;
  ng_size_t dsizes_coef[3];
  NclBasicDataTypes type_coef;
  NclObjClass type_obj_coef;
/*
 * Variables for returning the output array with attributes attached.
 */
  int att_id;
  ng_size_t dsizes[1];
  int *nattr, *mattr;
  NclMultiDValData att_md, return_md;
  NclVar tmp_var;
  NclStackEntry return_data;

/*
 * Various
 */
  int ier;
  ng_size_t i, j, m, l, ldim, l21, ml, mldim, ml21, lwsave, lwork, size_coef;
  ng_size_t ic0, ic1, ir0, ir1, ix0, ix1;
  double *wsave, *work;
  int il, im, ildim, ilwsave, ilwork;

/*
 * Retrieve input argument.
 *
 * Note any of the pointer parameters can be set to NULL, which
 * implies you don't care about its value.
 */
  x = (void*)NclGetArgValue(
           0,
           1,
           NULL,
           dsizes_x,
           NULL,
           NULL,
           &type_x,
           DONT_CARE);
/* 
 * Allocate space for coercing input array. Since we have to copy
 * the input array to a bigger array (tmp_r), we will go ahead and
 * make a copy of it.
 */
  m     = dsizes_x[0];
  l     = dsizes_x[1];
  l21   = (l/2) + 1;
  ldim  = 2 * l21;
  ml    = m * l;
  ml21  = m * l21;
  mldim = m * ldim;

  tmp_x = (double *)calloc(ml, sizeof(double));
  tmp_r = (double *)calloc(mldim, sizeof(double));

  if(tmp_x == NULL || tmp_r == NULL) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"fft2df: Unable to allocate memory for coercing input array to double");
    return(NhlFATAL);
  }

  coerce_subset_input_double(x,tmp_x,0,type_x,ml,0,NULL,NULL);

/*
 * Copy tmp_x to a subset of tmp_r.
 */
  for(i = 0; i < m; i++ ) {
    for(j = 0; j < l; j++ ) {
      ix0 = i*l + j;
      ix1 = i*ldim + j;
      tmp_r[ix1] = tmp_x[ix0];
    }
  }

/*
 * The output type defaults to float, unless the input array is double.
 */
  if(type_x != NCL_double) {
    type_coef =     NCL_float;
    type_obj_coef = nclTypefloatClass;
  }
  else {
    type_coef     = NCL_double;
    type_obj_coef = nclTypedoubleClass;
  }

/*
 * Calculate size of output array and allocate space for it.
 */
  dsizes_coef[0] = 2;
  dsizes_coef[1] = m;
  dsizes_coef[2] = l21;
  size_coef      = 2 * ml21;

  if(type_coef != NCL_double) {
    coef = (void *)calloc(size_coef, sizeof(float));
  }
  else {
    coef = (void *)calloc(size_coef, sizeof(double));
  }
  if(coef == NULL) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"fft2df: Unable to allocate memory for output array");
    return(NhlFATAL);
  }

/*
 * Test dimension sizes. 
 */
  lwsave = 2*m + l + (int)log((double)l) + (int)log((double)m) + 8;
  lwork  = mldim;
  if((l > INT_MAX) || (m > INT_MAX) || (ldim > INT_MAX) ||
     (lwsave > INT_MAX) || (lwork > INT_MAX)) { 
    NhlPError(NhlFATAL,NhlEUNKNOWN,"fft2df: one or more input dimension sizes are greater than INT_MAX");
    return(NhlFATAL);
  }
  il = (int) l;
  im = (int) m;
  ildim = (int) ldim;
  ilwsave = (int) lwsave;
  ilwork = (int) lwork;

/*
 * Allocate space for work arrays.
 */
  wsave  = (double *)calloc(lwsave,sizeof(double));
  work   = (double *)calloc(lwork,sizeof(double));
  if(work == NULL || wsave == NULL) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"fft2df: Unable to allocate memory for work arrays");
    return(NhlFATAL);
  }

/*
 * Call the Fortran routines.
 */
  ier = 0;
  NGCALLF(drfft2i,DRFFT2I)(&il, &im, wsave, &ilwsave, &ier);
  NGCALLF(drfft2f,DRFFT2F)(&ildim, &il, &im, tmp_r, wsave, &ilwsave, work, &ilwork,
                             &ier);
  if(ier) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"fft2df: ier = %d", ier);
    return(NhlFATAL);
  }
/*
 * Copy tmp_r back to the appropriate locations in coef.
 */
  if(type_coef == NCL_float) {
    for(i = 0; i < m; i++ ) {
      for(j = 0; j < l21; j++ ) {
        ic0 = i*l21 + j;
        ic1 = ml21 + ic0;
        ir0 = i*ldim + 2*j;
        ir1 = ir0 + 1;
        ((float*)coef)[ic0] = (float)tmp_r[ir0];
        ((float*)coef)[ic1] = (float)tmp_r[ir1];
      }
    }
  }
  else {
    for(i = 0; i < m; i++ ) {
      for(j = 0; j < l21; j++ ) {
        ic0 = i*l21 + j;
        ic1 = ml21 + ic0;
        ir0 = i*ldim + 2*j;
        ir1 = ir0 + 1;
        ((double*)coef)[ic0] = tmp_r[ir0];
        ((double*)coef)[ic1] = tmp_r[ir1];
      }
    }
  }

/*
 * Free unneeded memory.
 */
  NclFree(tmp_x);
  NclFree(tmp_r);
  NclFree(wsave);
  NclFree(work);

/*
 * Set up return value.
 */
  return_md = _NclCreateVal(
                            NULL,
                            NULL,
                            Ncl_MultiDValData,
                            0,
                            (void*)coef,
                            NULL,
                            3,
                            dsizes_coef,
                            TEMPORARY,
                            NULL,
                            type_obj_coef
                            );
/*
 * Set up attributes to return.
 */
  nattr = (int *)malloc(sizeof(int));
  mattr = (int *)malloc(sizeof(int));
  *nattr = l;
  *mattr = m; 

  att_id = _NclAttCreate(NULL,NULL,Ncl_Att,0,NULL);

  dsizes[0] = 1;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         (void*)nattr,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         (NclObjClass)nclTypeintClass
                         );
  _NclAddAtt(
             att_id,
             "N",
             att_md,
             NULL
             );
    
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         (void*)mattr,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         (NclObjClass)nclTypeintClass
                         );
  _NclAddAtt(
             att_id,
             "M",
             att_md,
             NULL
             );
    
  tmp_var = _NclVarCreate(
                          NULL,
                          NULL,
                          Ncl_Var,
                          0,
                          NULL,
                          return_md,
                          NULL,
                          att_id,
                          NULL,
                          RETURNVAR,
                          NULL,
                          TEMPORARY
                          );
/*
 * Return output grid and attributes to NCL.
 */
  return_data.kind = NclStk_VAR;
  return_data.u.data_var = tmp_var;
  _NclPlaceReturn(return_data);
  return(NhlNOERROR);

}
Пример #8
0
NhlErrorTypes cd_inv_calendar_W( void )
{
/*
 * Input array variables
 */
  int *year, *month, *day, *hour, *minute;
  void *second;
  double *tmp_second = NULL;
  NrmQuark *sspec;
  int *option;
  char *cspec;
  int ndims_year;
  ng_size_t dsizes_year[NCL_MAX_DIMENSIONS];
  int has_missing_year;
  int ndims_month;
  ng_size_t dsizes_month[NCL_MAX_DIMENSIONS];
  int has_missing_month;
  int ndims_day;
  ng_size_t dsizes_day[NCL_MAX_DIMENSIONS];
  int has_missing_day;
  int ndims_hour;
  ng_size_t dsizes_hour[NCL_MAX_DIMENSIONS];
  int has_missing_hour;
  int ndims_minute;
  ng_size_t dsizes_minute[NCL_MAX_DIMENSIONS];
  int has_missing_minute;
  int ndims_second;
  ng_size_t dsizes_second[NCL_MAX_DIMENSIONS];
  int has_missing_second;
  NclScalar missing_year;
  NclScalar missing_month;
  NclScalar missing_day;
  NclScalar missing_hour;
  NclScalar missing_minute;
  NclScalar missing_second;
  NclBasicDataTypes type_second;
  cdCompTime comptime;
/*
 * Variables for retrieving attributes from last argument.
 */
  NclAttList  *attr_list;
  NclAtt  attr_obj;
  NclStackEntry stack_entry;
  NrmQuark *scal;
  char   *ccal = NULL;
/*
 * Output variables.
 */
  double *x;
  int has_missing_x;
  NclScalar missing_x;
/*
 * Variables for returning "units" and "calendar" attributes.
 */
  NclQuark *units, *calendar;
  int att_id;
  NclMultiDValData att_md, return_md;
  NclVar tmp_var;
  NclStackEntry return_data;

/*
 * various
 */
  int ret;
  ng_size_t i, total_size_input;
  ng_size_t dsizes[1], return_missing;
  cdCalenType ctype;
  double fraction;

  /* initialize error flag */
  cuErrorOccurred = 0;

/*
 * Retrieve parameters
 *
 * Note any of the pointer parameters can be set to NULL, which
 * implies you don't care about its value.
 * The first size input arrays must be the same dimension sizes.
 */
  year = (int*)NclGetArgValue(
           0,
           8,
           &ndims_year, 
           dsizes_year,
           &missing_year,
           &has_missing_year,
           NULL,
           DONT_CARE);
  month = (int*)NclGetArgValue(
           1,
           8,
           &ndims_month, 
           dsizes_month,
           &missing_month,
           &has_missing_month,
           NULL,
           DONT_CARE);
  day = (int*)NclGetArgValue(
           2,
           8,
           &ndims_day, 
           dsizes_day,
           &missing_day,
           &has_missing_day,
           NULL,
           DONT_CARE);
  hour = (int*)NclGetArgValue(
           3,
           8,
           &ndims_hour, 
           dsizes_hour,
           &missing_hour,
           &has_missing_hour,
           NULL,
           DONT_CARE);
  minute = (int*)NclGetArgValue(
           4,
           8,
           &ndims_minute, 
           dsizes_minute,
           &missing_minute,
           &has_missing_minute,
           NULL,
           DONT_CARE);
  second = (void*)NclGetArgValue(
           5,
           8,
           &ndims_second, 
           dsizes_second,
           &missing_second,
           &has_missing_second,
           &type_second,
           DONT_CARE);

  if(ndims_year != ndims_month || ndims_year != ndims_day    || 
     ndims_year != ndims_hour  || ndims_year != ndims_minute ||
     ndims_year != ndims_second) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"cd_inv_calendar: The first six arguments must have the same dimensionality");
    return(NhlFATAL);
  }

  for(i = 0; i < ndims_year; i++ ) {
    if(dsizes_year[i] != dsizes_month[i]  ||
       dsizes_year[i] != dsizes_day[i]    || 
       dsizes_year[i] != dsizes_hour[i]   || 
       dsizes_year[i] != dsizes_minute[i] ||
       dsizes_year[i] != dsizes_second[i]) {
      
      NhlPError(NhlFATAL,NhlEUNKNOWN,"cd_inv_calendar: The first six arguments must have the same dimensionality");
      return(NhlFATAL);
    }
  }
/* 
 * x will contain a _FillValue attribute if any of the input
 * has a _FillValue attribute set.
 */
  if(has_missing_year || has_missing_month || has_missing_day ||
     has_missing_hour || has_missing_minute || has_missing_second) {
    has_missing_x = 1;
/*
 * Get the default missing value for a double type.
 */
    missing_x = ((NclTypeClass)nclTypedoubleClass)->type_class.default_mis;
  }
  else {
    has_missing_x = 0;
  }
/*
 * Get spec string.
 */
  sspec = (NrmQuark *)NclGetArgValue(
           6,
           8,
           NULL,
           NULL,
           NULL,
           NULL,
           NULL,
           1);
/*
 * Get option.
 */
  option = (int*)NclGetArgValue(
           7,
           8,
           NULL,
           NULL,
           NULL,
           NULL,
           NULL,
           1);

/* 
 * Check the "option" variable to see if it contains a "calendar"
 * attribute.
 */
  return_missing = 0;

  stack_entry = _NclGetArg(7, 8, DONT_CARE);
  switch (stack_entry.kind) {
  case NclStk_VAR:
    if (stack_entry.u.data_var->var.att_id != -1) {
      attr_obj = (NclAtt) _NclGetObj(stack_entry.u.data_var->var.att_id);
      if (attr_obj == NULL) {
        break;
      }
    }
    else {
/*
 * att_id == -1 ==> no attributes specified args given.
 */
      break;
    }
/* 
 * Get optional arguments.
 */
    if (attr_obj->att.n_atts > 0) {
/*
 * Get list of attributes.
 */
      attr_list = attr_obj->att.att_list;
/*
 * Loop through attributes and check them.
 */
      while (attr_list != NULL) {
        if ((strcmp(attr_list->attname, "calendar")) == 0) {
          scal = (NrmQuark *) attr_list->attvalue->multidval.val;
          ccal = NrmQuarkToString(*scal);
          if(strcasecmp(ccal,"standard") && strcasecmp(ccal,"gregorian") &&
             strcasecmp(ccal,"proleptic_gregorian") &&
             strcasecmp(ccal,"noleap")  && strcasecmp(ccal,"no_leap") &&
             strcasecmp(ccal,"allleap") && strcasecmp(ccal,"all_leap") &&
             strcasecmp(ccal,"365_day") && strcasecmp(ccal,"365") &&
             strcasecmp(ccal,"366_day") && strcasecmp(ccal,"366") &&
             strcasecmp(ccal,"360_day") && strcasecmp(ccal,"360") &&
             strcasecmp(ccal,"julian")  && strcasecmp(ccal,"none")) {
            NhlPError(NhlWARNING,NhlEUNKNOWN,"cd_inv_calendar: the 'calendar' attribute is not equal to a recognized calendar. Returning all missing values.");
            return_missing = has_missing_x = 1;
          }
        }
        attr_list = attr_list->next;
      }
    }
  default:
    break;
  }

/*
 * If no calendar attribute set, or "none" was selected, then use 
 * the default "standard".
 */
  if(ccal == NULL || !strcasecmp(ccal,"none")) {
    ctype = calendar_type("standard");
  }
  else {
    ctype = calendar_type(ccal);
  }

/*
 * Convert sspec to character string.
 */
  cspec = NrmQuarkToString(*sspec);

/*
 * Calculate total size of input arrays, and size and dimensions for
 * output array, and alloc memory for output array.
 */
  total_size_input = 1;
  for( i = 0; i < ndims_year; i++ ) total_size_input *= dsizes_year[i];

  x = (double *)calloc(total_size_input,sizeof(double));

  if( x == NULL ) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"cd_inv_calendar: Unable to allocate memory for output array");
    return(NhlFATAL);
  }
/*
 * Create tmp array for coercing second to double if necessary.
 */
  if(type_second != NCL_double) {
    tmp_second = (double*)calloc(1,sizeof(double));
    if(tmp_second == NULL) {
      NhlPError(NhlFATAL,NhlEUNKNOWN,"cd_inv_calendar: Unable to allocate memory for coercing second array to double precision");
      return(NhlFATAL);
    }
  }

/* 
 * Loop through each data value, and call Udunits routine.
 */ 
  for( i = 0; i < total_size_input; i++ ) {
/*
 * Coerce "second" to double, since this is what the original Udunits
 * routine is expecting. 
 */
    if(type_second != NCL_double) {
      coerce_subset_input_double(second,tmp_second,i,type_second,1,
                                 has_missing_second,&missing_second,NULL);
    }
    else {
      tmp_second = &((double*)second)[i];
    }

    if(!return_missing && (!has_missing_year   ||
        (has_missing_year && year[i]       != missing_year.intval))   &&
       (!has_missing_month ||
         (has_missing_month && month[i]    != missing_month.intval))  &&
       (!has_missing_day ||
         (has_missing_day && day[i]        != missing_day.intval))    &&
       (!has_missing_hour ||
         (has_missing_hour  && hour[i]     != missing_hour.intval))   &&
       (!has_missing_minute ||
         (has_missing_minute && minute[i]  != missing_minute.intval)) &&
       (!has_missing_second ||
        (has_missing_second && *tmp_second != missing_second.doubleval)) ) {

      fraction       = (double)minute[i]/60. + *tmp_second/3600.;
      comptime.year  = (long)year[i];
      comptime.month = (short)month[i];
      comptime.day   = (short)day[i];
      comptime.hour  = (double)hour[i] + fraction;
      (void)cdComp2Rel(ctype,comptime,cspec,&x[i]);
/*
 * Return all missing values if we encounter a fatal error.
 */
      if(i == 0 && (cuErrorOccurred && (cuErrOpts & CU_FATAL))) {
        set_all_missing(x, total_size_input, missing_x, 1);
        ret = NclReturnValue(x,ndims_year,dsizes_year,&missing_x,
                             NCL_double,0);
        if(type_second != NCL_double) NclFree(tmp_second);
        return(ret);
      }
    }
    else {
      x[i]  = missing_x.doubleval;
    }
  }

  if(type_second != NCL_double) NclFree(tmp_second);

/*
 * Set up variable to return.
 */
  if(has_missing_x) {
        return_md = _NclCreateVal(
                            NULL,
                            NULL,
                            Ncl_MultiDValData,
                            0,
                            x,
                            &missing_x,
                            ndims_year,
                            dsizes_year,
                            TEMPORARY,
                            NULL,
                            (NclObjClass)nclTypedoubleClass
                            );
  }
  else {
        return_md = _NclCreateVal(
                            NULL,
                            NULL,
                            Ncl_MultiDValData,
                            0,
                            x,
                            NULL,
                            ndims_year,
                            dsizes_year,
                            TEMPORARY,
                            NULL,
                            (NclObjClass)nclTypedoubleClass
                            );
  }

/*
 * Set up attributes to return.
 */
  att_id = _NclAttCreate(NULL,NULL,Ncl_Att,0,NULL);
  dsizes[0] = 1;

/*
 * Return "units" attribute.
 *
 * We can't just return "sspec" here, because it's an NCL input
 * parameter and this seems to screw things up if we try to
 * return it as an attribute.
 */
  units  = (NclQuark*)NclMalloc(sizeof(NclQuark));
  *units = NrmStringToQuark(cspec);

  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         (void*)units,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         (NclObjClass)nclTypestringClass
                         );
  _NclAddAtt(
             att_id,
             "units",
             att_md,
             NULL
             );

/*
 * Return "calendar" attribute.
 *
 * We can't just return "sspec" here, because it's an NCL input
 * parameter and this seems to screw things up if we try to
 * return it as an attribute.
 */
  calendar = (NclQuark*)NclMalloc(sizeof(NclQuark));
  if(ccal != NULL) {
    *calendar = NrmStringToQuark(ccal);
  }
  else {
    *calendar = NrmStringToQuark("standard");
  }
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         (void*)calendar,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         (NclObjClass)nclTypestringClass
                         );
  _NclAddAtt(
             att_id,
             "calendar",
             att_md,
             NULL
             );

  tmp_var = _NclVarCreate(
                          NULL,
                          NULL,
                          Ncl_Var,
                          0,
                          NULL,
                          return_md,
                          NULL,
                          att_id,
                          NULL,
                          RETURNVAR,
                          NULL,
                          TEMPORARY
                          );
/*
 * Return output grid and attributes to NCL.
 */
  return_data.kind = NclStk_VAR;
  return_data.u.data_var = tmp_var;
  _NclPlaceReturn(return_data);
  return(NhlNOERROR);

}
Пример #9
0
NhlErrorTypes cd_calendar_W( void )
{
/*
 * Input array variables
 */
  void *x;
  double *tmp_x;
  NrmQuark *sspec = NULL;
  char *cspec;
  int *option;
  int ndims_x;
  ng_size_t dsizes_x[NCL_MAX_DIMENSIONS];
  int has_missing_x;
  NclScalar missing_x, missing_dx;
  NclBasicDataTypes type_x;
/* 
 * Variables for calculating fraction of year,  if the option is 4.
 */
  int doy, nsid, total_seconds_in_year, seconds_in_doy, seconds_in_hour;
  int seconds_in_minute; 
  double current_seconds_in_year, fraction_of_year;

/*
 * Variables for retrieving attributes from the first argument.
 */
  NclAttList  *attr_list;
  NclAtt  attr_obj;
  NclStackEntry   stack_entry;
  NrmQuark *scal;
  const char   *ccal = NULL;
  cdCalenType ctype;
/*
 * Output variables.
 */
  cdCompTime comptime;
  int year, month, day, hour, minute;
  double second;
  void *date = NULL;
  int ndims_date = 0;
  ng_size_t *dsizes_date;
  NclScalar missing_date;
  NclBasicDataTypes type_date = NCL_none;
  NclObjClass type_date_t = NCL_none;
/*
 * Variables for returning "calendar" attribute.
 */
  int att_id;
  NclQuark *calendar;
  NclMultiDValData att_md, return_md;
  NclVar tmp_var;
  NclStackEntry return_data;

/*
 * various
 */
  int ret, return_missing;
  ng_size_t dsizes[1];
  ng_size_t i, total_size_x;
  ng_size_t total_size_date = 0;
  ng_size_t index_date;
  extern float truncf(float);

  /* initialize error flag */
  cuErrorOccurred = 0;
/*
 * Retrieve parameters
 *
 * Note any of the pointer parameters can be set to NULL, which
 * implies you don't care about its value.
 */
  x = (void*)NclGetArgValue(
           0,
           2,
           &ndims_x, 
           dsizes_x,
           &missing_x,
           &has_missing_x,
           &type_x,
           DONT_CARE);
/*
 * Get option.
 */

  option = (int*)NclGetArgValue(
           1,
           2,
           NULL,
           NULL,
           NULL,
           NULL,
           NULL,
           1);

/* 
 * The "units" attribute of "time" must be set, otherwise missing
 * values will be returned.
 *
 * The "calendar" option may optionally be set, but it must be equal to
 * one of the recognized calendars.
 */
  return_missing = 0;

  stack_entry = _NclGetArg(0, 2, DONT_CARE);
  switch (stack_entry.kind) {
  case NclStk_VAR:
    if (stack_entry.u.data_var->var.att_id != -1) {
      attr_obj = (NclAtt) _NclGetObj(stack_entry.u.data_var->var.att_id);
      if (attr_obj == NULL) {
        return_missing = 1;
        break;
      }
    }
    else {
/*
 * att_id == -1 ==> no attributes specified; return all missing.
 */
      return_missing = 1;
      break;
    }
/* 
 * Check for attributes. If none are specified, then return missing values.
 */
    if (attr_obj->att.n_atts == 0) {
      return_missing = 1;
      break;
    }
    else {
/*
 * Get list of attributes.
 */
      attr_list = attr_obj->att.att_list;
/*
 * Loop through attributes and check them.
 */
      while (attr_list != NULL) {
        if ((strcmp(attr_list->attname, "calendar")) == 0) {
          scal = (NrmQuark *) attr_list->attvalue->multidval.val;
          ccal = NrmQuarkToString(*scal);
          if(strcasecmp(ccal,"standard") && strcasecmp(ccal,"gregorian") &&
             strcasecmp(ccal,"proleptic_gregorian") &&
             strcasecmp(ccal,"noleap")  && strcasecmp(ccal,"no_leap") &&
             strcasecmp(ccal,"allleap") && strcasecmp(ccal,"all_leap") &&
             strcasecmp(ccal,"365_day") && strcasecmp(ccal,"365") &&
             strcasecmp(ccal,"366_day") && strcasecmp(ccal,"366") &&
             strcasecmp(ccal,"360_day") && strcasecmp(ccal,"360") &&
             strcasecmp(ccal,"julian")  && strcasecmp(ccal,"none")) {
            NhlPError(NhlWARNING,NhlEUNKNOWN,"cd_calendar: the 'calendar' attribute (%s) is not equal to a recognized calendar. Returning all missing values.",ccal);
            return_missing = 1;
          }
        }
        if ((strcmp(attr_list->attname, "units")) == 0) {
          sspec = (NrmQuark *) attr_list->attvalue->multidval.val;
        }
        attr_list = attr_list->next;
      }
    }
  default:
    break;
  }

/*
 * If no calendar attribute set, or "none" was selected, then use 
 * the default "standard".
 */
  if(ccal == NULL || !strcasecmp(ccal,"none")) {
    ctype = calendar_type("standard");
  }
  else {
    ctype = calendar_type(ccal);
  }

/*
 * Convert sspec to character string.
 */
  if(sspec == NULL) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"cd_calendar: no 'units' attribute provided");
    return(NhlFATAL);
  }
  cspec = NrmQuarkToString(*sspec);

/*
 * Calculate size of input array.
 */
  total_size_x = 1;
  for( i = 0; i < ndims_x; i++ ) total_size_x *= dsizes_x[i];

/*
 * Calculate size and dimensions for output array, and allocate
 * memory for output array.  The output size will vary depending
 * on what option the user has specified.  Only options -5 to 4
 * are currently recognized. (option = -4 doesn't exist.)
 */

  if(*option < -5 || *option > 4 || *option == -4) {
        NhlPError(NhlWARNING,NhlEUNKNOWN,"cd_calendar: Unknown option, defaulting to 0.");
        *option = 0;
  }

  if(*option == 0) {
        type_date   = NCL_float;
        type_date_t = nclTypefloatClass;
        total_size_date = 6 * total_size_x;
        missing_date    = ((NclTypeClass)nclTypefloatClass)->type_class.default_mis;
        ndims_date      = ndims_x + 1;
        date            = (float *)calloc(total_size_date,sizeof(float));
  }
  else if(*option == -5) {
/* identical to option=0, except returns ints */
        type_date       = NCL_int;
        type_date_t     = nclTypeintClass;
        total_size_date = 6 * total_size_x;
        missing_date    = ((NclTypeClass)nclTypeintClass)->type_class.default_mis;
        ndims_date      = ndims_x + 1;
        date            = (int *)calloc(total_size_date,sizeof(int));
  }
  else if(*option >= 1 && *option <= 4) {
        type_date       = NCL_double;
        type_date_t     = nclTypedoubleClass;
        total_size_date = total_size_x;
        missing_date    = ((NclTypeClass)nclTypedoubleClass)->type_class.default_mis;
        ndims_date      = ndims_x;
        date            = (double *)calloc(total_size_date,sizeof(double));
  }
  else if(*option >= -3 && *option <= -1) {
        type_date       = NCL_int;
        type_date_t     = nclTypeintClass;
        total_size_date = total_size_x;
        missing_date    = ((NclTypeClass)nclTypeintClass)->type_class.default_mis;
        ndims_date      = ndims_x;
        date            = (int *)calloc(total_size_date,sizeof(int));
  }
  dsizes_date = (ng_size_t *)calloc(ndims_date,sizeof(ng_size_t));

/*
 * Make sure we have enough memory for output.
 */
  if( date == NULL || dsizes_date == NULL) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"cd_calendar: Unable to allocate memory for output arrays");
    return(NhlFATAL);
  }

/*
 * Calculate output dimension sizes.
 */
  for( i = 0; i < ndims_x; i++ ) dsizes_date[i] = dsizes_x[i];
  if(*option == 0 || *option == -5) {
        dsizes_date[ndims_x] = 6;
  }

/*
 * Coerce missing values to double.
 */
  coerce_missing(type_x,has_missing_x,&missing_x,&missing_dx,NULL);

/* 
 * If we reach this point and return_missing is not 0, then either
 * "units" was invalid or wasn't set, or "calendar" was not a
 * recoginized calendar. We return all missing values in this case.
 */
  if(return_missing) {
    set_all_missing(date, total_size_date, missing_date, *option);
    ret = NclReturnValue(date,ndims_date,dsizes_date,
                          &missing_date,type_date,0);
    NclFree(dsizes_date);
    return(ret);
  }
            
/*
 * Convert input to double if necessary.
 */
  tmp_x = coerce_input_double(x,type_x,total_size_x,has_missing_x,&missing_x,
                  &missing_dx);

/* 
 * Loop through each element and get the 6 values.
 */
  index_date = 0;
  for( i = 0; i < total_size_x; i++ ) {
    if(!has_missing_x ||
       (has_missing_x && tmp_x[i] != missing_dx.doubleval)) {
      (void)cdRel2Iso_minsec(ctype,cspec,tmp_x[i],&comptime,&minute,&second);
/*
 * Return all missing values if we encounter a fatal error. 
 * Only check this once.
 */
      if(i == 0 && (cuErrorOccurred && (cuErrOpts & CU_FATAL))) {
        set_all_missing(date, total_size_date, missing_date, *option);
        ret = NclReturnValue(date,ndims_date,dsizes_date,
                             &missing_date,type_date,0);
        NclFree(dsizes_date);
        return(ret);
      }
      year  = (int)comptime.year;
      month = (int)comptime.month;
      day   = (int)comptime.day;
/*
 * comptime.hour is a double, and fractional. The "minute" and "second"
 * above are calculated from the fractional part of the hour.
 */
      hour  = (int)comptime.hour;
/*
 * Calculate the return values, based on the input option.
 */
      switch(*option) {

      case 0:
        ((float*)date)[index_date]   = (float)year;
        ((float*)date)[index_date+1] = (float)month;
        ((float*)date)[index_date+2] = (float)day;
        ((float*)date)[index_date+3] = (float)hour;
        ((float*)date)[index_date+4] = (float)minute;
        ((float*)date)[index_date+5] = second;
        break;

/* identical to option=0, except returns ints */
      case -5:
        ((int*)date)[index_date]   = year;
        ((int*)date)[index_date+1] = month;
        ((int*)date)[index_date+2] = day;
        ((int*)date)[index_date+3] = hour;
        ((int*)date)[index_date+4] = minute;
        ((int*)date)[index_date+5] = (int)truncf(second);
        break;

/*
 * YYYYMM
 */
      case -1:
        ((int*)date)[index_date] = (100*year) + month;
        break;

      case 1:
        ((double*)date)[index_date] = (double)(100*year) + (double)month;
        break;
/*
 * YYYYMMDD
 */
      case -2:
        ((int*)date)[index_date] = (10000*year) + (100*month) + day;
        break;

      case 2:
        ((double*)date)[index_date] = (double)(10000*year)
          + (double)(100*month) 
          + (double)day;
        break;

/*
 * YYYYMMDDHH
 */
      case -3:
        ((int*)date)[index_date] = (1000000*year) + (10000*month) 
          + (100*day) + hour;                
        break;
                
      case 3:
        ((double*)date)[index_date] = (double)(1000000*year) 
          + (double)(10000*month) 
          + (double)(100*day)
          + (double)hour;             
        break;
                
/*
 *  YYYY.fraction_of_year
 */
      case 4:
	nsid = 86400;      /* num seconds in a day */
        if(ccal == NULL) {
          total_seconds_in_year = seconds_in_year(year,"standard");
          doy = day_of_year(year,month,day,"standard");
        }
        else {
          total_seconds_in_year = seconds_in_year(year,ccal);
          doy = day_of_year(year,month,day,ccal);
        }
        if(doy > 1) {
          seconds_in_doy = (doy-1) * nsid;
        }
        else {
          seconds_in_doy = 0;
        }
        if(hour > 1) {
          seconds_in_hour  = (hour-1) * 3600;
        }
        else {
          seconds_in_hour  = 0;
        }
        if(minute > 1) {
          seconds_in_minute  = (minute-1) * 60;
        }
        else {
          seconds_in_minute  = 0;
        }
        current_seconds_in_year = seconds_in_doy + 
          seconds_in_hour + 
          seconds_in_minute + 
          second;
        fraction_of_year = current_seconds_in_year/(double)total_seconds_in_year;
        ((double*)date)[index_date] = (double)year + fraction_of_year;
        break;
      }
    }
    else {
      switch(*option) {

      case 0:
        ((float*)date)[index_date]   = missing_date.floatval;
        ((float*)date)[index_date+1] = missing_date.floatval;
        ((float*)date)[index_date+2] = missing_date.floatval;
        ((float*)date)[index_date+3] = missing_date.floatval;
        ((float*)date)[index_date+4] = missing_date.floatval;
        ((float*)date)[index_date+5] = missing_date.floatval;
        break;

/* identical to option=0, except returns ints */
      case -5:
        ((int*)date)[index_date]   = missing_date.intval;
        ((int*)date)[index_date+1] = missing_date.intval;
        ((int*)date)[index_date+2] = missing_date.intval;
        ((int*)date)[index_date+3] = missing_date.intval;
        ((int*)date)[index_date+4] = missing_date.intval;
        ((int*)date)[index_date+5] = missing_date.intval;
        break;

      case 1:
      case 2:
      case 3:
      case 4:
        ((double*)date)[index_date] = missing_date.doubleval;
        break;

      case -1:
      case -2:
      case -3:
        ((int*)date)[index_date] = missing_date.intval;
        break;
      }
    }
    if(*option == 0 || *option == -5) {
      index_date += 6;
    }
    else {
      index_date++;
    }
  }

/*
 * Free the work arrays.
 */

  if(type_x != NCL_double) NclFree(tmp_x);

/*
 * Set up variable to return.
 */
  if(has_missing_x) {
        return_md = _NclCreateVal(
                            NULL,
                            NULL,
                            Ncl_MultiDValData,
                            0,
                            date,
                            &missing_date,
                            ndims_date,
                            dsizes_date,
                            TEMPORARY,
                            NULL,
                            type_date_t
                            );
  }
  else {
        return_md = _NclCreateVal(
                            NULL,
                            NULL,
                            Ncl_MultiDValData,
                            0,
                            date,
                            NULL,
                            ndims_date,
                            dsizes_date,
                            TEMPORARY,
                            NULL,
                            type_date_t
                            );
  }

/*
 * Set up attributes to return.
 */
  att_id = _NclAttCreate(NULL,NULL,Ncl_Att,0,NULL);
  dsizes[0] = 1;

/*
 * Return "calendar" attribute.
 *
 * We can't just return "scal" here, because it's an NCL input
 * parameter and this seems to screw things up if we try to
 * return it as an attribute.
 */
  calendar = (NclQuark*)NclMalloc(sizeof(NclQuark));
  if(ccal != NULL) {
    *calendar = NrmStringToQuark(ccal);
  }
  else {
    *calendar = NrmStringToQuark("standard");
  }
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         (void*)calendar,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         (NclObjClass)nclTypestringClass
                         );
  _NclAddAtt(
             att_id,
             "calendar",
             att_md,
             NULL
             );

  tmp_var = _NclVarCreate(
                          NULL,
                          NULL,
                          Ncl_Var,
                          0,
                          NULL,
                          return_md,
                          NULL,
                          att_id,
                          NULL,
                          RETURNVAR,
                          NULL,
                          TEMPORARY
                          );

    NclFree(dsizes_date);
/*
 * Return output grid and attributes to NCL.
 */
  return_data.kind = NclStk_VAR;
  return_data.u.data_var = tmp_var;
  _NclPlaceReturn(return_data);
  return(NhlNOERROR);
}
Пример #10
0
NhlErrorTypes specxy_anal_W( void )
{
/*
 * Input array variables
 */
  void *x, *y, *pct;
  double *dx, *dy, *dpct;
  ng_size_t dsizes[1], nx;
  int *iopt, *jave;
  int ndims_x;
  ng_size_t dsizes_x[NCL_MAX_DIMENSIONS];
  int ndims_y;
  ng_size_t dsizes_y[NCL_MAX_DIMENSIONS];
  int has_missing_x, has_missing_y;
  NclScalar missing_x, missing_y, missing_dx, missing_dy;
  NclBasicDataTypes type_x, type_y, type_pct;
  ng_size_t lwork;
  double scl, *work;
/*
 * Output variables
 */
  void *dof;
  NclBasicDataTypes type_dof;
  NclObjClass type_output;
/*
 * Attribute variables
 */
  int att_id;
  NclMultiDValData att_md, return_md;
  NclVar tmp_var;
  NclStackEntry return_data;
  double *frq_tmp, *spcx_tmp, *spcy_tmp;
  double *cospc_tmp, *quspc_tmp, *coher_tmp, *phase_tmp;
  double prob_tmp[4], sinfo[50];
  void *bw, *frq, *spcx, *spcy, *cospc, *quspc, *coher, *phase;
  void *xavei, *xvari, *xvaro, *xlag1, *xslope;
  void *yavei, *yvari, *yvaro, *ylag1, *yslope; 
  void *prob;
/*
 * Declare variables for random purposes.
 */
  ng_size_t i, nspc, nspcmx, total_size_x, total_size_y;
  int ier;
/*
 * Retrieve arguments.
 */
  x = (void*)NclGetArgValue(
          0,
          5,
          &ndims_x,
          dsizes_x,
          &missing_x,
          &has_missing_x,
          &type_x,
          DONT_CARE);

  y = (void*)NclGetArgValue(
          1,
          5,
          &ndims_y,
          dsizes_y,
          &missing_y,
          &has_missing_y,
          &type_y,
          DONT_CARE);

  iopt = (int*)NclGetArgValue(
          2,
          5,
          NULL,
          NULL,
          NULL,
          NULL,
          NULL,
          DONT_CARE);

  jave = (int*)NclGetArgValue(
          3,
          5,
          NULL,
          NULL,
          NULL,
          NULL,
          NULL,
          DONT_CARE);

  pct = (void*)NclGetArgValue(
          4,
          5,
          NULL,
          NULL,
          NULL,
          NULL,
          &type_pct,
          DONT_CARE);
/*
 * Check input.
 */
  nx   = dsizes_x[0];
  nspc = nspcmx = nx/2 + 1;

  if( nx != dsizes_y[0]) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"specxy_anal: 'x' and 'y' must have the same number of elements");
    return(NhlFATAL);
  }
  if( nx < 3) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"specxy_anal: 'x' and 'y' must have more than 3 elements");
    return(NhlFATAL);
  }

  if( *iopt > 2) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"specxy_anal: 'iopt' must be <= 2");
    return(NhlFATAL);
  }

  if( abs(*jave) > nx/2 ) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"specxy_anal: 'jave' must be <= nx/2");
    return(NhlFATAL);
  }

/*
 * Compute the total number of elements in our arrays.
 */
  total_size_x = 1;
  for(i = 0; i < ndims_x; i++) total_size_x *= dsizes_x[i];

  total_size_y = 1;
  for(i = 0; i < ndims_y; i++) total_size_y *= dsizes_y[i];
/*
 * Check for missing values and coerce data if necessary.
 */
  coerce_missing(type_x,has_missing_x,&missing_x,&missing_dx,NULL);
  coerce_missing(type_y,has_missing_y,&missing_y,&missing_dy,NULL);
/*
 * Coerce x/y to double precision if necessary.
 */
  dx = coerce_input_double(x,type_x,total_size_x,has_missing_x,&missing_x,
                           &missing_dx);
  dy = coerce_input_double(y,type_y,total_size_y,has_missing_y,&missing_y,
                           &missing_dy);
  if(dx == NULL|| dy == NULL) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"specxy_anal: Unable to allocate memory for coercing input arrays to double precision");
    return(NhlFATAL);
  }
/*  
 * Check if x or y contains missing values.
 */
  if(contains_missing(dx,total_size_x,has_missing_x,missing_dx.doubleval) ||
     contains_missing(dy,total_size_y,has_missing_y,missing_dy.doubleval)) {
     NhlPError(NhlFATAL,NhlEUNKNOWN,"specx_anal: x and y cannot contain any missing values");
     return(NhlFATAL);
  }
/*
 * Coerce pct to double precision if necessary.
 */
  dpct = coerce_input_double(pct,type_pct,1,0,NULL,NULL);
  if( dpct == NULL ) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"specxy_anal: Unable to allocate memory for coercing pct array to double precision");
    return(NhlFATAL);
  }
/*
 * Check pct.
 */
  if( *dpct < 0.0 || *dpct > 1.0 ) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"specxy_anal: 'pct' must be between 0 and 1 inclusive");
    return(NhlFATAL);
  }
/*
 * Check if any input is double.
 */
  if(type_x != NCL_double && type_y != NCL_double && 
     type_pct != NCL_double) {

    type_dof = NCL_float;
    type_output = nclTypefloatClass;
/* 
 * Allocate space for float output variables.
 */
    dof      = (void *)calloc(1,sizeof(float));
    frq      = (void *)calloc(nspcmx-1,sizeof(float));
    spcx     = (void *)calloc(nspcmx-1,sizeof(float));
    spcy     = (void *)calloc(nspcmx-1,sizeof(float));
    cospc    = (void *)calloc(nspcmx-1,sizeof(float));
    quspc    = (void *)calloc(nspcmx-1,sizeof(float));
    coher    = (void *)calloc(nspcmx-1,sizeof(float));
    phase    = (void *)calloc(nspcmx-1,sizeof(float));
    bw       = (void *)calloc(1,sizeof(float));
    prob     = (void *)calloc(4,sizeof(float));
    xavei    = (void *)calloc(1,sizeof(float));
    xvari    = (void *)calloc(1,sizeof(float));
    xvaro    = (void *)calloc(1,sizeof(float));
    xlag1    = (void *)calloc(1,sizeof(float));
    xslope   = (void *)calloc(1,sizeof(float));
    yavei    = (void *)calloc(1,sizeof(float));
    yvari    = (void *)calloc(1,sizeof(float));
    yvaro    = (void *)calloc(1,sizeof(float));
    ylag1    = (void *)calloc(1,sizeof(float));
    yslope   = (void *)calloc(1,sizeof(float));
  }
  else {
    type_dof = NCL_double;
    type_output = nclTypedoubleClass;
/*
 * Allocate space for double output variables.
 */
    dof     = (void *)calloc(1,sizeof(double));
    bw      = (void *)calloc(1,sizeof(double));
    prob    = (void *)calloc(4,sizeof(double));
    frq     = (void *)calloc(nspcmx-1,sizeof(double));
    spcx    = (void *)calloc(nspcmx-1,sizeof(double));
    spcy    = (void *)calloc(nspcmx-1,sizeof(double));
    cospc   = (void *)calloc(nspcmx-1,sizeof(double));
    quspc   = (void *)calloc(nspcmx-1,sizeof(double));
    coher   = (void *)calloc(nspcmx-1,sizeof(double));
    phase   = (void *)calloc(nspcmx-1,sizeof(double));
    xavei   = (void *)calloc(1,sizeof(double));
    xvari   = (void *)calloc(1,sizeof(double));
    xvaro   = (void *)calloc(1,sizeof(double));
    xlag1   = (void *)calloc(1,sizeof(double));
    xslope  = (void *)calloc(1,sizeof(double));
    yavei   = (void *)calloc(1,sizeof(double));
    yvari   = (void *)calloc(1,sizeof(double));
    yvaro   = (void *)calloc(1,sizeof(double));
    ylag1   = (void *)calloc(1,sizeof(double));
    yslope  = (void *)calloc(1,sizeof(double));
  }
  if(   dof == NULL ||    bw == NULL || xavei == NULL || xvari == NULL ||
        frq == NULL ||  spcx == NULL ||  spcy == NULL || cospc == NULL ||
      quspc == NULL || coher == NULL || phase == NULL || xvaro == NULL ||
      xlag1 == NULL ||xslope == NULL || yavei == NULL || yvari == NULL ||
      yvaro == NULL || ylag1 == NULL ||yslope == NULL ||  prob == NULL) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"specxy_anal: Unable to allocate memory for output variables");
    return(NhlFATAL);
  }

/*
 * Allocate space for stuff to be returned by dspecx.
 */
  frq_tmp   = (double *)calloc(nspcmx,sizeof(double));
  spcx_tmp  = (double *)calloc(nspcmx,sizeof(double));
  spcy_tmp  = (double *)calloc(nspcmx,sizeof(double));
  cospc_tmp = (double *)calloc(nspcmx,sizeof(double));
  quspc_tmp = (double *)calloc(nspcmx,sizeof(double));
  coher_tmp = (double *)calloc(nspcmx,sizeof(double));
  phase_tmp = (double *)calloc(nspcmx,sizeof(double));
  if(    frq_tmp == NULL ||  spcx_tmp == NULL ||  spcy_tmp == NULL || 
       cospc_tmp == NULL || quspc_tmp == NULL || coher_tmp == NULL || 
       phase_tmp == NULL) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"specxy_anal: Unable to allocate memory for output variables");
    return(NhlFATAL);
  }

/*
 * Allocate space for work array.
 */
  lwork = 10 * nx;
  work  = (double *)calloc(lwork,sizeof(double));
  if( work == NULL ) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"specxy_anal: Unable to allocate memory for work array");
    return(NhlFATAL);
  }
/*
 * Call the Fortran version of this routine.
 */
  scl = 2.0;
  if((nx <= INT_MAX) &&
     (lwork <= INT_MAX) &&
     (nspc <= INT_MAX))
  {
      int inx = (int) nx;
      int ilwork = (int) lwork;
      int inspc = (int) nspc;
      NGCALLF(dspecxy,DSPECXY)(dx,dy,&inx,iopt,jave,dpct,&scl,work,&ilwork,
                               frq_tmp,spcx_tmp,spcy_tmp,cospc_tmp,quspc_tmp,
                               coher_tmp,phase_tmp,&inspc,sinfo,&ier);
  }
  else
  {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"specxy_anal: one or more input dimensions is greater than INT_MAX", nx);
    return(NhlFATAL);
  }

  if( ier > 700000 ) {
    NhlPError(NhlWARNING,NhlEUNKNOWN,"specxy_anal: 'x' and/or 'y' contains all constant values");
  }
/*
 * Calculate coherence corresponding to the 90, 95, 99, and 99.9% levels.
 */
  prob_tmp[0] = 1.-pow((1.-0.900),(1./(sinfo[0]/2.-1.)));
  prob_tmp[1] = 1.-pow((1.-0.950),(1./(sinfo[0]/2.-1.)));
  prob_tmp[2] = 1.-pow((1.-0.990),(1./(sinfo[0]/2.-1.)));
  prob_tmp[3] = 1.-pow((1.-0.999),(1./(sinfo[0]/2.-1.)));


  coerce_output_float_or_double(   dof,    &sinfo[0],type_dof,1,0);
  coerce_output_float_or_double( xlag1,    &sinfo[1],type_dof,1,0);
  coerce_output_float_or_double( ylag1,    &sinfo[2],type_dof,1,0);
  coerce_output_float_or_double(    bw,    &sinfo[5],type_dof,1,0);
  coerce_output_float_or_double(  prob,     prob_tmp,type_dof,4,0);
  coerce_output_float_or_double( xavei,   &sinfo[10],type_dof,1,0);
  coerce_output_float_or_double( xvari,   &sinfo[11],type_dof,1,0);
  coerce_output_float_or_double( xvaro,   &sinfo[12],type_dof,1,0);
  coerce_output_float_or_double(xslope,   &sinfo[31],type_dof,1,0);
  coerce_output_float_or_double( yavei,   &sinfo[20],type_dof,1,0);
  coerce_output_float_or_double( yvari,   &sinfo[21],type_dof,1,0);
  coerce_output_float_or_double( yvaro,   &sinfo[22],type_dof,1,0);
  coerce_output_float_or_double(yslope,   &sinfo[34],type_dof,1,0);

  coerce_output_float_or_double(   frq,  &frq_tmp[1],type_dof,nspcmx-1,0);
  coerce_output_float_or_double(  spcx, &spcx_tmp[1],type_dof,nspcmx-1,0);
  coerce_output_float_or_double(  spcy, &spcy_tmp[1],type_dof,nspcmx-1,0);
  coerce_output_float_or_double( cospc,&cospc_tmp[1],type_dof,nspcmx-1,0);
  coerce_output_float_or_double( quspc,&quspc_tmp[1],type_dof,nspcmx-1,0);
  coerce_output_float_or_double( coher,&coher_tmp[1],type_dof,nspcmx-1,0);
  coerce_output_float_or_double( phase,&phase_tmp[1],type_dof,nspcmx-1,0);

/*
 * Set up variable to return.
 */
  dsizes[0] = 1;
  return_md = _NclCreateVal(
                            NULL,
                            NULL,
                            Ncl_MultiDValData,
                            0,
                            dof,
                            NULL,
                            1,
                            dsizes,
                            TEMPORARY,
                            NULL,
                            type_output
                            );
  /*
   * Set up attributes to return.
   */
  att_id = _NclAttCreate(NULL,NULL,Ncl_Att,0,NULL);
  
  dsizes[0] = nspcmx-1;      /* returning nx/2 points, not nx/2 + 1 */
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         spcx,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "spcx",
             att_md,
             NULL
             );
  
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         spcy,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "spcy",
             att_md,
             NULL
             );
  
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         frq,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "frq",
             att_md,
             NULL
             );
  
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         cospc,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "cospc",
             att_md,
             NULL
             );
  
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         quspc,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "quspc",
             att_md,
             NULL
             );
  
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         coher,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "coher",
             att_md,
             NULL
             );
  
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         phase,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "phase",
             att_md,
             NULL
             );
  
  dsizes[0] = 1;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         bw,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "bw",
             att_md,
             NULL
             );
  
  dsizes[0] = 4;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         prob,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "coher_probability",
             att_md,
             NULL
             );
  
  dsizes[0] = 1;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         xavei,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "xavei",
             att_md,
             NULL
             );
  
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         xvari,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "xvari",
             att_md,
             NULL
             );
  
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         xvaro,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "xvaro",
             att_md,
             NULL
             );
  
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         xlag1,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "xlag1",
             att_md,
             NULL
             );
  
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         xslope,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "xslope",
             att_md,
             NULL
             );
  
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         yavei,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  
  _NclAddAtt(
             att_id,
             "yavei",
             att_md,
             NULL
             );
  
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         yvari,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "yvari",
             att_md,
             NULL
             );
  
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         yvaro,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "yvaro",
             att_md,
             NULL
             );
  
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         ylag1,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "ylag1",
             att_md,
             NULL
             );
  
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         yslope,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "yslope",
             att_md,
             NULL
             );
/*
 * Free up memory.
 */
  NclFree(work);
  if((void*)dx   != x) NclFree(dx);
  if((void*)dy   != y) NclFree(dy);
  if((void*)dpct != pct) NclFree(dpct);

  NclFree(frq_tmp);
  NclFree(spcx_tmp);
  NclFree(spcy_tmp);
  NclFree(cospc_tmp);
  NclFree(quspc_tmp);
  NclFree(coher_tmp);
  NclFree(phase_tmp);
/*
 * Return variable.
 */
  tmp_var = _NclVarCreate(
                          NULL,
                          NULL,
                          Ncl_Var,
                          0,
                          NULL,
                          return_md,
                          NULL,
                          att_id,
                          NULL,
                          RETURNVAR,
                          NULL,
                          TEMPORARY
                          );
/*
 * Return output grid and attributes to NCL.
 */
  return_data.kind = NclStk_VAR;
  return_data.u.data_var = tmp_var;
  _NclPlaceReturn(return_data);
  return(NhlNOERROR);
}
Пример #11
0
NhlErrorTypes specx_anal_W( void )
{
/*
 * Input array variables
 */
  void *x, *pct;
  double *dx, *dpct;
  ng_size_t dsizes[1];
  ng_size_t nx;
  int *iopt, *jave;
  int ndims_x;
  ng_size_t dsizes_x[NCL_MAX_DIMENSIONS];
  int has_missing_x;
  NclScalar missing_x, missing_dx;
  NclBasicDataTypes type_x, type_pct;
  ng_size_t lwork;
  double scl, *work;
/*
 * Output variables
 */
  void *dof;
  NclBasicDataTypes type_dof;
  NclObjClass type_output;
/*
 * Attribute variables
 */
  int att_id;
  NclMultiDValData att_md, return_md;
  NclVar tmp_var;
  NclStackEntry return_data;
  double *frq_tmp, *spcx_tmp, sinfo[50];
  void *spcx, *frq, *bw, *xavei, *xvari, *xvaro, *xlag1, *xslope;
/*
 * Declare variables for random purposes.
 */
  ng_size_t i, nspcmx, nspc, total_size_x;
  int ier;

/*
 * Retrieve arguments.
 */
  x = (void*)NclGetArgValue(
          0,
          4,
          &ndims_x,
          dsizes_x,
          &missing_x,
          &has_missing_x,
          &type_x,
          DONT_CARE);

  iopt = (int*)NclGetArgValue(
          1,
          4,
          NULL,
          NULL,
          NULL,
          NULL,
          NULL,
          DONT_CARE);
  
  jave = (int*)NclGetArgValue(
          2,
          4,
          NULL,
          NULL,
          NULL,
          NULL,
          NULL,
          DONT_CARE);


  pct = (void*)NclGetArgValue(
          3,
          4,
          NULL,
          NULL,
          NULL,
          NULL,
          &type_pct,
          DONT_CARE);
/*
 * Check input.
 */
  if( *iopt > 2) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"specx_anal: 'iopt' must be <= 2");
    return(NhlFATAL);
  }

  nx = dsizes_x[0];
  nspc = nspcmx = nx/2 + 1;
  if( nx < 3) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"specx_anal: 'x' must have more than 3 elements");
    return(NhlFATAL);
  }

  if( abs(*jave) > nx/2 ) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"specx_anal: 'jave' must be <= nx/2");
    return(NhlFATAL);
  }

/*
 * Compute the total number of elements in our array.
 */
  total_size_x = 1;
  for(i = 0; i < ndims_x; i++) total_size_x *= dsizes_x[i];
/*
 * Check for missing values.
 */
  coerce_missing(type_x,has_missing_x,&missing_x,&missing_dx,NULL);
/*
 * Coerce x to double precision if necessary.
 */
  dx = coerce_input_double(x,type_x,total_size_x,has_missing_x,&missing_x,
                           &missing_dx);
  if( dx == NULL ) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"specx_anal: Unable to allocate memory for coercing x array to double precision");
    return(NhlFATAL);
  }
/*  
 * Check if x contains missing values.
 */
  if(contains_missing(dx,total_size_x,has_missing_x,missing_dx.doubleval)) {
     NhlPError(NhlFATAL,NhlEUNKNOWN,"specx_anal: 'x' cannot contain any missing values");
     return(NhlFATAL);
  }
/*
 * Coerce pct to double precision if necessary.
 */
  dpct = coerce_input_double(pct,type_pct,1,0,NULL,NULL);
  if( dpct == NULL ) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"specx_anal: Unable to allocate memory for coercing pct array to double precision");
    return(NhlFATAL);
  }
/*
 * Check pct.
 */
  if( *dpct < 0.0 || *dpct > 1.0 ) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"specx_anal: 'pct' must be between 0 and 1 inclusive");
    return(NhlFATAL);
  }
/*
 * Check if any input is double.
 */
  if(type_x != NCL_double && type_pct != NCL_double) {
    type_dof    = NCL_float;
    type_output = nclTypefloatClass;
/*
 * Allocate space for float output variables.
 */
    dof     = (void *)calloc(1,sizeof(float));
    frq     = (void *)calloc(nspcmx-1,sizeof(float));
    spcx    = (void *)calloc(nspcmx-1,sizeof(float));
    bw      = (void *)calloc(1,sizeof(float));
    xavei   = (void *)calloc(1,sizeof(float));
    xvari   = (void *)calloc(1,sizeof(float));
    xvaro   = (void *)calloc(1,sizeof(float));
    xlag1   = (void *)calloc(1,sizeof(float));
    xslope  = (void *)calloc(1,sizeof(float));
  }
  else {
    type_dof    = NCL_double;
    type_output = nclTypedoubleClass;
/*
 * Allocate space for double output variables.
 */
    dof     = (void *)calloc(1,sizeof(double));
    frq     = (void *)calloc(nspcmx-1,sizeof(double));
    spcx    = (void *)calloc(nspcmx-1,sizeof(double));
    bw      = (void *)calloc(1,sizeof(double));
    xavei   = (void *)calloc(1,sizeof(double));
    xvari   = (void *)calloc(1,sizeof(double));
    xvaro   = (void *)calloc(1,sizeof(double));
    xlag1   = (void *)calloc(1,sizeof(double));
    xslope  = (void *)calloc(1,sizeof(double));
  }
  if(   dof == NULL ||    bw == NULL ||  spcx == NULL ||   frq == NULL ||
      xavei == NULL || xvari == NULL || xvaro == NULL || xlag1 == NULL ||
     xslope == NULL) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"specx_anal: Unable to allocate memory for output variables");
    return(NhlFATAL);
  }
/*
 * Allocate space for stuff to be returned by dspecx.
 */
  frq_tmp  = (double *)calloc(nspcmx,sizeof(double));
  spcx_tmp = (double *)calloc(nspcmx,sizeof(double));
  if( frq_tmp == NULL || spcx_tmp == NULL) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"specx_anal: Unable to allocate memory for output variables");
    return(NhlFATAL);
  }

/*
 * Allocate space for work array.
 */
  lwork = 5 * nx + 18 + abs(*jave);
  work  = (double *)calloc(lwork,sizeof(double));
  if( work == NULL ) {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"specx_anal: Unable to allocate memory for work array");
    return(NhlFATAL);
  }
/*
 * Call the Fortran version of this routine.
 */
  scl = 2.0;
  if((nx <= INT_MAX) &&
     (lwork <= INT_MAX) &&
     (nspc <= INT_MAX))
  {
      int inx = (int) nx;
      int ilwork = (int) lwork;
      int inspc = (int) nspc;
      NGCALLF(dspecx,DSPECX)(dx,&inx,iopt,jave,dpct,&scl,work,&ilwork,
                             frq_tmp,spcx_tmp,&inspc,sinfo,&ier);
  }
  else
  {
    NhlPError(NhlFATAL,NhlEUNKNOWN,"specx_anal: one or more input dimensions is greater than INT_MAX", nx);
    return(NhlFATAL);
  }


  if( ier > 700000 ) {
    NhlPError(NhlWARNING,NhlEUNKNOWN,"specx_anal: 'x' contains all constant values");
  }

  coerce_output_float_or_double(   dof,    &sinfo[0],type_dof,1,0);
  coerce_output_float_or_double( xlag1,    &sinfo[1],type_dof,1,0);
  coerce_output_float_or_double(    bw,    &sinfo[5],type_dof,1,0);
  coerce_output_float_or_double( xavei,   &sinfo[10],type_dof,1,0);
  coerce_output_float_or_double( xvari,   &sinfo[11],type_dof,1,0);
  coerce_output_float_or_double( xvaro,   &sinfo[12],type_dof,1,0);
  coerce_output_float_or_double(xslope,   &sinfo[31],type_dof,1,0);
  coerce_output_float_or_double(   frq,  &frq_tmp[1],type_dof,nspcmx-1,0);
  coerce_output_float_or_double(  spcx, &spcx_tmp[1],type_dof,nspcmx-1,0);

/*
 * Free up memory.
 */
  NclFree(frq_tmp);
  NclFree(spcx_tmp);
  NclFree(work);
  if((void*)dx   != x) NclFree(dx);
  if((void*)dpct != pct) NclFree(dpct);

/*
 * Set up variable to return.
 */
  dsizes[0] = 1;
  return_md = _NclCreateVal(
                            NULL,
                            NULL,
                            Ncl_MultiDValData,
                            0,
                            dof,
                            NULL,
                            1,
                            dsizes,
                            TEMPORARY,
                            NULL,
                            type_output
                            );
/*
 * Set up attributes to return.
 */
  att_id = _NclAttCreate(NULL,NULL,Ncl_Att,0,NULL);
    
  dsizes[0] = nspcmx-1;      /* returning nx/2 points, not nx/2 + 1 */
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         spcx,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "spcx",
             att_md,
             NULL
             );
    
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         frq,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "frq",
             att_md,
             NULL
             );
    
  dsizes[0] = 1;
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         bw,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "bw",
             att_md,
             NULL
             );
    
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         xavei,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "xavei",
             att_md,
             NULL
             );
    
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         xvari,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "xvari",
             att_md,
             NULL
             );
    
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         xvaro,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "xvaro",
             att_md,
             NULL
             );
    
  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         xlag1,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "xlag1",
             att_md,
             NULL
             );

  att_md = _NclCreateVal(
                         NULL,
                         NULL,
                         Ncl_MultiDValData,
                         0,
                         xslope,
                         NULL,
                         1,
                         dsizes,
                         TEMPORARY,
                         NULL,
                         type_output
                         );
  _NclAddAtt(
             att_id,
             "xslope",
             att_md,
             NULL
             );
  tmp_var = _NclVarCreate(
                          NULL,
                          NULL,
                          Ncl_Var,
                          0,
                          NULL,
                          return_md,
                          NULL,
                          att_id,
                          NULL,
                          RETURNVAR,
                          NULL,
                          TEMPORARY
                          );
/*
 * Return output grid and attributes to NCL.
 */
  return_data.kind = NclStk_VAR;
  return_data.u.data_var = tmp_var;
  _NclPlaceReturn(return_data);
  return(NhlNOERROR);
}