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

/*******************************************************************************
*/