/* fixed.c ********************************************************************************
* 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;
}
/*******************************************************************************
*/