/*
******************************************************************************** * fixed.c -- Routines for fixed statistical series objects * * User routines * Pro_FixedStat() creates a fixed statistical series object. * * Version 1.0: Original release. * Mark Showalter, PDS Ring-Moon Systems Node, March 1998. * Version 1.1: Support for Pro_StatRange() function added. * Mark Showalter, January 2000 *******************************************************************************/ #include <stdio.h> #include "profile.h" #include "fortran.h" /******************** * Type definitions * ********************/ typedef struct ZPRO_FIXED_STRUCT { XPRO_CLASS class; PRO_OBJECT *series; RL_INT4 span; RL_FLT8 *covars; } ZPRO_FIXED; /******************** * Static variables * ********************/ static XPRO_CLASS fixedstat_class = {XPRO_FIXED_CLASS, "fixed", NULL}; /******************************** * Internal function prototypes * ********************************/ static RL_FLT8 ZPro_FixedValue RL_PROTO((RL_VOID *pointer, RL_INT4 k, RL_INT4 *flag)); static RL_FLT8 ZPro_FixedCovar RL_PROTO((RL_VOID *pointer, RL_INT4 k1, RL_INT4 k2)); static void ZPro_FixedRange RL_PROTO((RL_VOID *pointer, RL_INT4 k, RL_INT4 *k1, RL_INT4 *k2)); static void ZPro_FreeFixed RL_PROTO((RL_VOID *pointer)); static void ZPro_PrintFixed RL_PROTO((RL_VOID *pointer)); /* ******************************************************************************** * EXPORTED USER ROUTINES ******************************************************************************** *$ Component_name: * Pro_FixedStat (fixed.c) *$ Abstract: * This routine creates and returns a new statistical series in which the * covariances are a constant function of the distance between points. *$ Keywords: * PROFILE, SERIES * C, PUBLIC, SUBROUTINE *$ Declarations: * PRO_OBJECT *Pro_FixedStat(series, span, covars) * PRO_OBJECT *series; * RL_INT4 span; * RL_FLT8 *covars; *$ Inputs: * series pointer to the series object. * span span of statistical series, i.e. the maximum distance * between correlated samples. * covars[0..span] array of covariances as a function of sample separation * distance. *$ Outputs: * none *$ Returns: * pointer to a new statistical series, or NULL on non-fatal error. *$ Detailed_description: * This routine creates and returns a new statistical series in which the * covariances are a constant function of the distance between points. The * series samples are copied from another series object. *$ External_references: * Profile toolkit *$ Side_effects: * Memory is allocated. The new series creates a link to the original * series. *$ Examples: * This snippet of code creates a statistical series that returns the same * samples as another (non-statistical) series, where samples are treated * as uncorrelated and with equal, unit uncertainty. * * PRO_OBJECT *stat, *series; * RL_FLT8 covars[1] = {1.}; * * stat = Pro_FixedStat(series, 0, covars); *$ Error_handling: * Profile library error handling is in effect. * * Conditions raised: * RL_MEMORY_ERROR on memory allocation failure. * PRO_CLASS_ERROR if the given object is NULL or is not a series. *$ Limitations: * none *$ Author_and_institution: * Mark R. Showalter * NASA/Ames Research Center *$ Version_and_date: * 1.0: March 1998 * 1.1: January 2000 *$ Change_history: * 1.1: Support for correlation range calculations added. *******************************************************************************/ PRO_OBJECT *Pro_FixedStat(series, span, covars) PRO_OBJECT *series; RL_INT4 span; RL_FLT8 *covars; { ZPRO_FIXED *stat; PRO_OBJECT *new; RL_INT4 k1, k2, count, dk; RL_FLT8 x1, dx; /* Get parameters of series */ count = Pro_SeriesIndices(series, &k1, &k2); if (count == 0) return NULL; (void) Pro_SeriesSampling(series, &x1, NULL, &dx); /* Allocate new fixed statistical series structure */ stat = (ZPRO_FIXED *) XRL_Malloc(sizeof(ZPRO_FIXED)); if (stat == NULL) return NULL; stat->covars = (RL_FLT8 *) XRL_Malloc((span+1) * sizeof(RL_FLT8)); if (stat->covars == NULL) { XRL_Free((RL_VOID *) stat); return NULL; } /* Initialize structure */ stat->class = fixedstat_class; stat->series = series; stat->span = span; for (dk=0; dk<=span; dk++) { stat->covars[dk] = covars[dk]; } /* Create new statistical series object */ new = XPro_MakeStat(k1, k2, x1, dx, ZPro_FixedValue, ZPro_FixedCovar, ZPro_FixedRange, ZPro_FreeFixed, ZPro_PrintFixed, (RL_VOID *) stat); /* Enslave old series and check for errors */ if (new != NULL && XPro_EnslaveObject(new, series)) { Pro_FreeObject(new); new = NULL; } /* Transfer coordinate names to new stat series */ Pro_RenameObject(new, 1, Pro_ObjectName(series,1)); Pro_RenameObject(new, 2, Pro_ObjectName(series,2)); return new; } /* ******************************************************************************** * INTERNAL ROUTINES ******************************************************************************** * ZPro_FixedValue(pointer, k, flag) * * This internal routine evaluates the value of a fixed statistical series by * evaluating the enslaved series object. * * Inputs: * pointer pointer to the ZPRO_FIXED structure. * k index at which to evaluate series. * * Outputs: * *flag flag value of series. * * Returns: value of series at k. *******************************************************************************/ static RL_FLT8 ZPro_FixedValue(pointer, k, flag) RL_VOID *pointer; RL_INT4 k, *flag; { ZPRO_FIXED *stat; stat = (ZPRO_FIXED *) pointer; return Pro_SeriesValue(stat->series, k, flag); } /* ******************************************************************************** * ZPro_FixedCovar(pointer, k1, k2) * * This internal routine evaluates the covariance of a fixed statistical series. * * Inputs: * pointer pointer to the ZPRO_FIXED structure. * k1, k2 index pair at which to evaluate covariance. * * Returns: value of covariance between k and k+dk; *******************************************************************************/ static RL_FLT8 ZPro_FixedCovar(pointer, k1, k2) RL_VOID *pointer; RL_INT4 k1, k2; { ZPRO_FIXED *stat; RL_INT4 dk; stat = (ZPRO_FIXED *) pointer; dk = k2 - k1; if (dk < 0) dk = -dk; if (dk > stat->span) return 0; return (stat->covars)[dk]; } /* ******************************************************************************** * ZPro_FixedRange(pointer, k, k1, k2) * * This internal routine evaluates the range of correlated samples in a fixed * statistical series. * * Inputs: * pointer pointer to the ZPRO_FIXED structure. * k index at which to evaluate correlation range. * * Outputs: * k1, k2 range of indices within which samples are correlated. * * Returns: none. *******************************************************************************/ static void ZPro_FixedRange(pointer, k, k1, k2) RL_VOID *pointer; RL_INT4 k, *k1, *k2; { ZPRO_FIXED *stat; stat = (ZPRO_FIXED *) pointer; *k1 = k - stat->span; *k2 = k + stat->span; } /* ******************************************************************************** * ZPro_FreeFixed(pointer) * * This internal routine deallocates the memory used by a fixed statistical * series. * * Input: * pointer pointer to the ZPRO_FIXED structure. *******************************************************************************/ static void ZPro_FreeFixed(pointer) RL_VOID *pointer; { ZPRO_FIXED *stat; stat = (ZPRO_FIXED *) pointer; XRL_Free((RL_VOID *) stat->covars); XRL_Free(pointer); } /* ******************************************************************************** * ZPro_PrintFixed(pointer) * * This internal routine prints information about a fixed statistical series. * * Input: * pointer pointer to the ZPRO_FIXED structure. *******************************************************************************/ static void ZPro_PrintFixed(pointer) RL_VOID *pointer; { ZPRO_FIXED *stat; RL_INT4 k; stat = (ZPRO_FIXED *) pointer; /* Make sure object is not NULL */ if (stat == NULL) { printf("PRINT ERROR: Fixed statistical series pointer is NULL\n"); return; } /* Make sure object is a fixed statistical series */ if (stat->class.id != XPRO_FIXED_CLASS) { printf("PRINT ERROR: Object is not a fixed statistical series\n"); return; } /* Print object info... */ printf("\nFixed statistical series parameters...\n"); printf(" series = "); XPro_PrintInfo(stat->series); for (k = 0; k <= stat->span; k++) printf("covar[%1d] = %#g\n", k, (stat->covars)[k]); return; } /* ******************************************************************************** * FORTRAN INTERFACE ROUTINES ******************************************************************************** *$ Component_name: * FPro_FixedStat (fixed.c) *$ Abstract: * This routine creates and returns a new statistical series in which the * covariances are a constant function of the distance between points. *$ Keywords: * PROFILE, SERIES * FORTRAN, PUBLIC, SUBROUTINE *$ Declarations: * real*8 function FPro_FixedStat(series, span, covar) * integer*4 series, span * real*8 covar(0:span) *$ Inputs: * series FORTRAN pointer to the series object. * span span of statistical series, i.e. the maximum distance * between correlated samples. * covars(0:span) array of covariances as a function of sample separation * distance. *$ Outputs: * none *$ Returns: * FORTRAN pointer to a new statistical series, or 0 on non-fatal error. *$ Detailed_description: * This routine creates and returns a new statistical series in which the * covariances are a constant function of the distance between points. The * series samples are copied from another series object. *$ External_references: * Profile toolkit *$ Side_effects: * Memory is allocated. The new series creates a link to the original * series. *$ Examples: * This snippet of code creates a statistical series that returns the same * samples as another (non-statistical) series, where samples are treated * as uncorrelated and with equal, unit uncertainty. * * integer*4 stat, series * real*8 covars(1)/ 1.d0 / * * stat = FPro_FixedStat(series, 0, covars) *$ Error_handling: * Profile library error handling is in effect. * * Conditions raised: * RL_MEMORY_ERROR on memory allocation failure. * PRO_CLASS_ERROR if the given object is NULL or is not a series. * FORTRAN_POINTER_ERROR if object is not a valid FORTRAN object pointer. *$ Limitations: * none *$ Author_and_institution: * Mark R. Showalter * NASA/Ames Research Center *$ Version_and_date: * 1.0: March 1998 *$ Change_history: * none *******************************************************************************/ RL_INT4 FORTRAN_NAME(fpro_fixedstat) (series, span, covar) RL_INT4 *series, *span; RL_FLT8 *covar; { RL_INT4 index; RL_VOID *ptr; /* Look up series pointer */ ptr = FORT_GetPointer(*series); if (ptr == NULL) return 0; /* Call function */ ptr = (RL_VOID *) Pro_FixedStat((PRO_OBJECT *) ptr, *span, covar); if (ptr == NULL) return 0; /* Save new pointer */ index = FORT_AddPointer(ptr); if (index == 0) Pro_FreeObject((PRO_OBJECT *) ptr); return index; } /********************************************************************************/