/* series.c
********************************************************************************
* series.c -- Routines for generic series objects
*
* User routines:
* Pro_SeriesValue() returns the value of a series.
* Pro_SeriesIndices() returns the index-range of a series.
* Pro_SeriesSampling() returns the x-coordinate sampling of a series.
* Pro_SeriesIndex() converts an x-value to an index.
* Pro_SeriesXValue() converts an index to an x-value.
* Pro_WindowSeries() creates a new series object with a different
* index range from the original series.
*
* Programmer routines:
* XPro_MakeSeries() creates a series object.
* XPro_SeriesPtr() returns a pointer to the series sub-object.
*
* Version 1.0: Original release.
* Mark Showalter & Neil Heather, PDS Ring-Moon Systems Node, March 1998.
* Version 1.1: QUICK compilation mode added.
* Mark Showalter, October 1999.
*******************************************************************************/
#include <stdio.h>
#include <string.h>
#include "profile.h"
#include "fortran.h"
/*************************
* Data type definitions *
*************************/
typedef struct ZPRO_SERIES_STRUCT {
XPRO_CLASS class;
RL_INT4 k1, k2;
RL_FLT8 x1, x2, dx;
RL_FLT8 (*evalfunc) RL_PROTO((RL_VOID *pointer, RL_INT4 k,
RL_INT4 *flag));
void (*freefunc) RL_PROTO((RL_VOID *pointer));
void (*printfunc) RL_PROTO((RL_VOID *pointer));
RL_VOID *pointer;
} ZPRO_SERIES;
/********************
* Static variables *
********************/
static RL_CHAR ZPRO_BLANK = '\0';
static XPRO_CLASS series_class = {XPRO_SERIES_CLASS, "series", NULL};
/************************************
* Prototypes of internal functions *
************************************/
static void ZPro_FreeSeries RL_PROTO((RL_VOID *pointer));
static void ZPro_PrintSeries RL_PROTO((RL_VOID *pointer));
static ZPRO_SERIES *ZPro_GetSeries RL_PROTO((PRO_OBJECT *object));
/*********************
* Macro definitions *
*********************/
#ifdef QUICK
#define ZPro_GetSeries(object) ((ZPRO_SERIES *) XPro_ObjectPtr(object))
#endif
/*
********************************************************************************
* EXPORTED USER ROUTINES
********************************************************************************
*$ Component_name:
* Pro_SeriesValue (series.c)
*$ Abstract:
* This routine returns one sample value from a series object.
*$ Keywords:
* PROFILE, SERIES
* C, PUBLIC, SUBROUTINE
*$ Declarations:
* RL_FLT8 Pro_SeriesValue(object, k, flag)
* PRO_OBJECT *object;
* RL_INT4 k, *flag;
*$ Inputs:
* object pointer to a series object.
* k index into series.
*$ Outputs:
* *flag 0 if value is valid; PRO_MISSING_FLAG=1 if missing;
* PRO_INVALID_FLAG=2 if invalid or if object is not a
* series. These constants are defined in include file
* profile.h. This value is not returned if flag==NULL.
*$ Returns:
* sample value from series; 0. on error or if flag is nonzero.
*$ Detailed_description:
* This routine returns one sample value from a series object, given the
* index. It also sets a flag to zero if the sample is valid or nonzero
* if it is invalid or missing or if the index is out of range.
*$ External_references:
* Profile toolkit
*$ Side_effects:
* none
*$ Examples:
* Suppose we have a series with six samples, such that series[k] = k for
* 1 <= k <= 5 and series[6] is invalid.
*
* Then Pro_SeriesValue(series, 4, &flag) returns 4. and sets flag = 0;
* Pro_SeriesValue(series, 5, &flag) returns 5. and sets flag = 0;
* Pro_SeriesValue(series, 6, &flag) returns 0. and sets flag = 2;
* Pro_SeriesValue(series, 7, &flag) raises PRO_DOMAIN_ERROR,
* returns 0. and sets flag = 1
*$ Error_handling:
* Profile toolkit error handling is in effect.
*
* Conditions raised:
* PRO_CLASS_ERROR if object is NULL or not a series.
* PRO_DOMAIN_ERROR if k is outside the allowed range.
* PRO_EVALUATION_FAILURE if the series could not be evaluated.
*
* On a non-fatal error, 0. is returned. On PRO_DOMAIN_ERROR the
* PRO_MISSING_FLAG flag is returned; on PRO_EVALUATION_ERROR the
* PRO_INVALID_FLAG flag is returned; otherwise the flag is unchanged.
*$ Limitations:
* none
*$ Author_and_institution:
* Mark R. Showalter
* NASA/Ames Research Center
*$ Version_and_date:
* 1.0: March 1998
* 1.1: October 1999
*$ Change_history:
* 1.1: QUICK mode compile option added.
*******************************************************************************/
RL_FLT8 Pro_SeriesValue(object, k, flag)
PRO_OBJECT *object;
RL_INT4 k, *flag;
{
ZPRO_SERIES *series;
RL_FLT8 value;
RL_INT4 internal_flag;
series = ZPro_GetSeries(object);
#ifndef QUICK
if (series == NULL) return 0.;
#endif
/* Make sure k is inside index range */
if (k < series->k1 || k > series->k2) {
XPro_IDomainError("series index", object, series->k1, series->k2, k);
if (flag != NULL) *flag = PRO_MISSING_FLAG;
return 0.;
}
/* Look up value in series */
value = (series->evalfunc) (series->class.pointer, k, &internal_flag);
if (flag != NULL) *flag = internal_flag;
return value;
}
/*
********************************************************************************
*$ Component_name:
* Pro_SeriesIndices (series.c)
*$ Abstract:
* This routine returns the limiting index values for a series.
*$ Keywords:
* PROFILE, SERIES
* C, PUBLIC, SUBROUTINE
*$ Declarations:
* RL_INT4 Pro_SeriesIndices(object, k1, k2)
* PRO_OBJECT *object;
* RL_INT4 *k1, *k2;
*$ Inputs:
* object pointer to a series object.
*$ Outputs:
* *k1 lower index; unchanged on error.
* *k2 upper index; unchanged on error.
* Note: Each of the above is returned only if the address does not equal
* NULL. They are unchanged on error.
*$ Returns:
* number of samples, i.e. k2 - k1 + 1; 0 on error.
*$ Detailed_description:
* This routine returns the limiting index values for a series.
*$ External_references:
* Profile toolkit
*$ Side_effects:
* none
*$ Examples:
* Suppose we have a series with six samples, such that series[k] = k for
* 0 <= k <= 5.
*
* Then Pro_SeriesIndices(series, &k1, &k2) sets k1=0, k2=5 and returns 6.
*$ Error_handling:
* Profile toolkit error handling is in effect.
*
* Conditions raised:
* PRO_CLASS_ERROR if object is NULL or not a series.
*$ Limitations:
* none
*$ Author_and_institution:
* Mark R. Showalter
* NASA/Ames Research Center
*$ Version_and_date:
* 1.0: March 1998
* 1.1: October 1999
*$ Change_history:
* 1.1: QUICK mode compile option added.
*******************************************************************************/
RL_INT4 Pro_SeriesIndices(object, k1, k2)
PRO_OBJECT *object;
RL_INT4 *k1, *k2;
{
ZPRO_SERIES *series;
series = ZPro_GetSeries(object);
#ifndef QUICK
if (series == NULL) return 0;
#endif
if (k1 != NULL) *k1 = series->k1;
if (k2 != NULL) *k2 = series->k2;
return (series->k2 - series->k1 + 1);
}
/*
********************************************************************************
*$ Component_name:
* Pro_SeriesSampling (series.c)
*$ Abstract:
* This routine returns the sampling variable limits and interval for a
* series.
*$ Keywords:
* PROFILE, SERIES
* C, PUBLIC, SUBROUTINE
*$ Declarations:
* RL_FLT8 Pro_SeriesSampling(object, x1, x2, dx)
* PRO_OBJECT *object;
* RL_FLT8 *x1, *x2, *dx;
*$ Inputs:
* object pointer to a series object.
*$ Outputs:
* *x1 lower limit (corresponding to index k1).
* *x2 upper limit (corresponding to index k2).
* *dx interval between successive samples.
* Note: Each of the above is returned only if the address does not equal
* NULL. They are unchanged on error.
*$ Returns:
* size of the x-range, i.e. (x2 - x1), or 0. on error.
*$ Detailed_description:
* This routine returns the sampling variable limits and interval for a
* series.
*
* The sampling variable is a double-precision quantity that varies in
* direct proportion to the sample index. It often relates the index to a
* specific physical quantity such as time or radius in a series.
*$ External_references:
* Profile toolkit
*$ Side_effects:
* none
*$ Examples:
* Suppose we have a series with six samples, such that series[k] = k for
* 0 <= k <= 5. The series samples are (0.11, 0.22, 0.33, 0.44, 0.55,
* 0.66)
*
* Then Pro_SeriesSampling(series, &x1, &x2, &dx) sets x1=0.11, x2=0.66,
* dx=0.11, and returns 0.55.
*$ Error_handling:
* Profile toolkit error handling is in effect.
*
* Conditions raised:
* PRO_CLASS_ERROR if object is NULL or not a series.
*$ Limitations:
* none
*$ Author_and_institution:
* Mark R. Showalter
* NASA/Ames Research Center
*$ Version_and_date:
* 1.0: March 1998
* 1.1: October 1999
*$ Change_history:
* 1.1: QUICK mode compile option added.
*******************************************************************************/
RL_FLT8 Pro_SeriesSampling(object, x1, x2, dx)
PRO_OBJECT *object;
RL_FLT8 *x1, *x2, *dx;
{
ZPRO_SERIES *series;
series = ZPro_GetSeries(object);
#ifndef QUICK
if (series == NULL) return 0.;
#endif
if (x1 != NULL) *x1 = series->x1;
if (x2 != NULL) *x2 = series->x2;
if (dx != NULL) *dx = series->dx;
return (series->x2 - series->x1);
}
/*
********************************************************************************
*$ Component_name:
* Pro_SeriesIndex (series.c)
*$ Abstract:
* This routine converts a series sampling value to an index.
*$ Keywords:
* PROFILE, SERIES
* C, PUBLIC, SUBROUTINE
*$ Declarations:
* RL_FLT8 Pro_SeriesIndex(object, x)
* PRO_OBJECT *object;
* RL_FLT8 x;
*$ Inputs:
* object pointer to a series object.
* x sampling parameter value.
*$ Outputs:
* none
*$ Returns:
* index value as a double-precision value.
*$ Detailed_description:
* This routine converts a series sampling value to an index. The value
* returned is in double precision and may need to be converted to an
* integer before use.
*
* The sampling variable is a double-precision quantity that varies in
* direct proportion to the sample index. It often relates the index to a
* specific physical quantity such as time or radius in a series.
*$ External_references:
* Profile toolkit
*$ Side_effects:
* none
*$ Examples:
* Suppose we have a series with six samples, such that series[k] = k for
* 0 <= k <= 5. The series samples are (0.11, 0.22, 0.33, 0.44, 0.55,
* 0.66)
*
* Then Pro_SeriesIndex(series, 0.22) returns 1.;
* Pro_SeriesIndex(series, 0.33) returns 2.;
* Pro_SeriesIndex(series, 0.275) returns 1.5.
*$ Error_handling:
* Profile toolkit error handling is in effect.
*
* Conditions raised:
* PRO_CLASS_ERROR if object is NULL or not a series.
*$ Limitations:
* none
*$ Author_and_institution:
* Mark R. Showalter
* NASA/Ames Research Center
*$ Version_and_date:
* 1.0: March 1998
* 1.1: October 1999
*$ Change_history:
* 1.1: QUICK mode compile option added.
*******************************************************************************/
RL_FLT8 Pro_SeriesIndex(object, x)
PRO_OBJECT *object;
RL_FLT8 x;
{
ZPRO_SERIES *series;
series = ZPro_GetSeries(object);
#ifndef QUICK
if (series == NULL) return 0.;
#endif
return series->k1 + (x - series->x1) / series->dx;
}
/*
********************************************************************************
*$ Component_name:
* Pro_SeriesXValue (series.c)
*$ Abstract:
* This routine converts a series index to a sampling parameter value.
*$ Keywords:
* PROFILE, SERIES
* C, PUBLIC, SUBROUTINE
*$ Declarations:
* RL_FLT8 Pro_SeriesXValue(object, k)
* PRO_OBJECT *object;
* RL_FLT8 k;
*$ Inputs:
* object pointer to a series object.
* k index value (double precision).
*$ Outputs:
* none
*$ Returns:
* sampling parameter value.
*$ Detailed_description:
* This routine converts a series index to a sampling parameter value.
* The index value must be given in double precision, not integer format.
*
* The sampling variable is a double-precision quantity that varies in
* direct proportion to the sample index. It often relates the index to a
* specific physical quantity such as time or radius in a series.
*$ External_references:
* Profile toolkit
*$ Side_effects:
* none
*$ Examples:
* Suppose we have a series with six samples, such that series[k] = k for
* 0 <= k <= 5. The series samples are (0.11, 0.22, 0.33, 0.44, 0.55,
* 0.66)
*
* Then Pro_SeriesXValue(series, 1.) return 0.22;
* Pro_SeriesXValue(series, 2.) returns 0.33;
* Pro_SeriesXValue(series, 1.5) returns 0.275.
*$ Error_handling:
* Profile toolkit error handling is in effect.
*
* Conditions raised:
* PRO_CLASS_ERROR if object is NULL or not a series.
*$ Limitations:
* none
*$ Author_and_institution:
* Mark R. Showalter
* NASA/Ames Research Center
*$ Version_and_date:
* 1.0: March 1998
* 1.1: October 1999
*$ Change_history:
* 1.1: QUICK mode compile option added.
*******************************************************************************/
RL_FLT8 Pro_SeriesXValue(object, k)
PRO_OBJECT *object;
RL_FLT8 k;
{
ZPRO_SERIES *series;
series = ZPro_GetSeries(object);
#ifndef QUICK
if (series == NULL) return 0.;
#endif
return (series->x1 + (k - series->k1) * series->dx);
}
/*
********************************************************************************
*$ Component_name:
* Pro_WindowSeries (series.c)
*$ Abstract:
* This routine returns a new series object with a different index range
* than the original series.
*$ Keywords:
* PROFILE, SERIES
* C, PUBLIC, SUBROUTINE
*$ Declarations:
* PRO_OBJECT *Pro_WindowSeries(object, k1, k2)
* PRO_OBJECT *object;
* RL_INT4 k1, k2;
*$ Inputs:
* object pointer to a series object.
* k1 new lower index (inclusive).
* k2 new upper index (inclusive).
*$ Outputs:
* none
*$ Returns:
* pointer to a new series object, or NULL on non-fatal error.
*$ Detailed_description:
* This routine returns a new series object with a different index range
* than the original series. The new domain is generally narrower than the
* original but need not be; the intersection of the two ranges is used and
* samples for which no value exists are flagged as missing (see
* Pro_SeriesValue).
*$ External_references:
* Profile toolkit
*$ Side_effects:
* none
*$ Examples:
* Suppose we have a series with six samples, such that series[k] = k for
* 1 <= k <= 5 and series[6] is invalid.
*
* Then Pro_WindowSeries(series, 3, 7) creates a new series with 4 samples,
* such that series[k] = k for 3 <= k <= 5 and series[6] is invalid. Any
* other value of k raises PRO_DOMAIN_ERROR.
*$ Error_handling:
* Profile toolkit error handling is in effect.
*
* Conditions raised:
* PRO_CLASS_ERROR if object is NULL or not a series.
* PRO_EMPTY_DOMAIN if the windowed series would have an empty
* domain.
* RL_MEMORY_ERROR on memory allocation failure.
*$ Limitations:
* none
*$ Author_and_institution:
* Mark R. Showalter
* NASA/Ames Research Center
*$ Version_and_date:
* 1.0: March 1998
*$ Change_history:
* none
*******************************************************************************/
PRO_OBJECT *Pro_WindowSeries(object, k1, k2)
PRO_OBJECT *object;
RL_INT4 k1, k2;
{
ZPRO_SERIES *series;
PRO_OBJECT *new;
RL_INT4 k1a, k2a;
series = ZPro_GetSeries(object);
if (series == NULL) return NULL;
/* Find intersection of new and old index ranges */
k1a = k1;
k2a = k2;
if (k1a < series->k1) k1a = series->k1;
if (k2a > series->k2) k2a = series->k2;
/* Make sure range is not empty */
if (k1a >= k2a) {
XPro_IEmptyDomain("windowed series", object, NULL,
series->k1, series->k2, k1, k2);
return NULL;
}
/* Duplicate series object */
new = XPro_MakeSeries(k1a, k2a,
series->x1 + (k1 - series->k1) * series->dx, series->dx,
series->evalfunc, series->freefunc, series->printfunc,
series->class.pointer);
/* Enslave original object and check for allocation errors */
if (new != NULL && XPro_EnslaveObject(new, object)) {
Pro_FreeObject(new);
new = NULL;
}
/* Transfer coordinate names to new object */
Pro_RenameObject(new, 1, Pro_ObjectName(object,1));
Pro_RenameObject(new, 2, Pro_ObjectName(object,2));
return new;
}
/*
********************************************************************************
* EXPORTED PROGRAMMER ROUTINES
********************************************************************************
* XPro_MakeSeries(k1, k2, x1, dx, evalfunc, freefunc, printfunc, pointer)
*
* This routine creates and initializes a series object.
*
* Inputs:
* k1, k2 index limits.
* x1 minimum X value, corresponding to first sample.
* dx x-interval between consecutive samples.
* evalfunc routine to evaluate series.
* freefunc routine to free data structure.
* printfunc routine to print series data structure
* pointer pointer to an arbitrary data structure describing the
* series.
*
* Returns: new series object.
*
* Errors:
* RL_MEMORY_ERROR on memory allocation failure.
*******************************************************************************/
PRO_OBJECT *XPro_MakeSeries(k1, k2, x1, dx,
evalfunc, freefunc, printfunc, pointer)
RL_INT4 k1, k2;
RL_FLT8 x1, dx;
RL_FLT8 (*evalfunc) RL_PROTO((RL_VOID *pointer, RL_INT4 k,
RL_INT4 *flag));
void (*freefunc) RL_PROTO((RL_VOID *pointer));
void (*printfunc) RL_PROTO((RL_VOID *pointer));
RL_VOID *pointer;
{
ZPRO_SERIES *series;
PRO_OBJECT *new;
/* Allocate new series structure */
series = (ZPRO_SERIES *) XRL_Malloc(sizeof(ZPRO_SERIES));
if (series == NULL) return NULL;
/* Initialize structure */
series->class = series_class;
series->class.pointer = pointer;
series->k1 = k1;
series->k2 = k2;
series->x1 = x1;
series->x2 = x1 + dx * (series->k2 - series->k1);
series->dx = dx;
series->evalfunc = evalfunc;
series->freefunc = freefunc;
series->printfunc = printfunc;
/* Create new object */
new = XPro_MakeObject(series->x1, series->x2,
ZPro_FreeSeries, ZPro_PrintSeries,
(RL_VOID *) series);
return new;
}
/*
********************************************************************************
* XPro_SeriesPtr(object)
*
* This routine returns the pointer field of a generic series object.
*
* Inputs:
* object series object.
*
* Return: pointer field of the object; NULL on error.
*
* Errors:
* PRO_CLASS_ERROR if object is NULL or not a series.
*******************************************************************************/
#ifndef QUICK /* In QUICK mode, this is defined as a macro in profile.h */
RL_VOID *XPro_SeriesPtr(object)
PRO_OBJECT *object;
{
ZPRO_SERIES *series;
series = ZPro_GetSeries(object);
if (series == NULL) return NULL;
if (series->class.pointer == NULL)
XPro_NullError("series sub-object", object);
return series->class.pointer;
}
#endif
/*
********************************************************************************
* INTERNAL ROUTINES
********************************************************************************
* ZPro_FreeSeries(pointer)
*
* This internal routine deallocates the memory used by a generic series object.
*
* Input:
* pointer pointer to the ZPRO_SERIES structure.
*******************************************************************************/
static void ZPro_FreeSeries(pointer)
RL_VOID *pointer;
{
ZPRO_SERIES *series;
series = (ZPRO_SERIES *) pointer;
if (series == NULL) return;
if (series->class.pointer != NULL)
(series->freefunc) (series->class.pointer);
XRL_Free(series);
}
/*
********************************************************************************
* ZPro_PrintSeries(pointer)
*
* This routine prints out information on the object.
*
* Input:
* pointer pointer to series object.
*******************************************************************************/
static void ZPro_PrintSeries(pointer)
RL_VOID *pointer;
{
ZPRO_SERIES *series;
series = (ZPRO_SERIES *) pointer;
/* Make sure object is not NULL */
if (series == NULL) {
printf("PRINT ERROR: Series pointer is NULL\n");
return;
}
/* Make sure object is a series */
if (series->class.id != XPRO_SERIES_CLASS) {
printf("PRINT ERROR: Object is not a series\n");
return;
}
/* Print object info... */
printf("\nGeneric series parameters...\n");
printf(" indices = [%1d,%1d]\n", series->k1, series->k2);
printf("sampling = %#g, %#g, %#g\n", series->x1,
series->x1 + (series->k2 - series->k1) * series->dx, series->dx);
(series->printfunc)(series->class.pointer);
}
/*
********************************************************************************
* ZPro_GetSeries(object)
*
* This internal routine returns a pointer to the object's ZPRO_SERIES data
* structure.
*
* Input:
* object series object.
*
* Return: pointer to ZPRO_SERIES structure, or NULL on error.
*
* Errors:
* PRO_CLASS_ERROR if object is NULL or not a series.
*******************************************************************************/
#ifndef QUICK /* In QUICK mode, this is defined as a macro above */
static ZPRO_SERIES *ZPro_GetSeries(object)
PRO_OBJECT *object;
{
ZPRO_SERIES *series;
/* Find series object pointer */
series = (ZPRO_SERIES *) XPro_ObjectPtr(object);
/* Make sure object is not NULL */
if (series == NULL) {
XPro_NullError("series", object);
return NULL;
}
/* Make sure object is a series */
if (series->class.id != XPRO_SERIES_CLASS) {
XPro_ClassError("series", object);
return NULL;
}
return (ZPRO_SERIES *) object->class.pointer;
}
#endif
/*
********************************************************************************
* FORTRAN INTERFACE ROUTINES
********************************************************************************
*$ Component_name:
* FPro_SeriesValue (series.c)
*$ Abstract:
* This routine returns one sample value from a series object.
*$ Keywords:
* PROFILE, SERIES
* FORTRAN, PUBLIC, SUBROUTINE
*$ Declarations:
* real*8 function FPro_SeriesValue(object, k, flag)
* integer*4 object, k, flag
*$ Inputs:
* object FORTRAN pointer to a series object.
* k index into series.
*$ Outputs:
* flag 0 if value is valid; PRO_MISSING_FLAG=1 if missing;
* PRO_INVALID_FLAG=2 if invalid or if object is not a
* series. These constants are defined in include file
* fprofile.inc.
*$ Returns:
* sample value from series; 0. on error or if flag is nonzero.
*$ Detailed_description:
* This routine returns one sample value from a series object, given the
* index. It also sets a flag to zero if the sample is valid or nonzero
* if it is invalid or missing or if the index is out of range.
*$ External_references:
* Profile toolkit
*$ Side_effects:
* none
*$ Examples:
* Suppose we have a series with six samples, such that series(k) = k for
* 1 <= k <= 5 and series(6) is invalid.
*
* Then FPro_SeriesValue(series, 4, flag) returns 4.d0 and sets flag = 0;
* FPro_SeriesValue(series, 5, flag) returns 5.d0 and sets flag = 0;
* FPro_SeriesValue(series, 6, flag) returns 0.d0 and sets flag = 2;
* FPro_SeriesValue(series, 7, flag) raises PRO_DOMAIN_ERROR,
* returns 0.d0 and sets flag = 1
*$ Error_handling:
* Profile toolkit error handling is in effect.
*
* Conditions raised:
* PRO_CLASS_ERROR if object is NULL or not a series.
* PRO_DOMAIN_ERROR if k is outside the allowed range.
* PRO_EVALUATION_FAILURE if the series could not be evaluated.
* FORTRAN_POINTER_ERROR if object is not a valid FORTRAN object pointer.
*
* On a non-fatal error, 0. is returned. On PRO_DOMAIN_ERROR the
* PRO_MISSING_FLAG flag is returned; on PRO_EVALUATION_ERROR the
* PRO_INVALID_FLAG flag is returned; otherwise the flag is unchanged.
*$ Limitations:
* none
*$ Author_and_institution:
* Mark R. Showalter
* NASA/Ames Research Center
*$ Version_and_date:
* 1.0: March 1998
* 1.1: October 1999
*$ Change_history:
* 1.1: QUICK mode compile option added.
*******************************************************************************/
RL_FLT8 FORTRAN_NAME(fpro_seriesvalue) (object, k, flag)
RL_INT4 *object, *k, *flag;
{
RL_VOID *ptr;
/* Look up series pointer */
ptr = FORT_GetPointer(*object);
#ifndef QUICK
if (ptr == NULL) return 0.;
#endif
/* Call function */
return Pro_SeriesValue((PRO_OBJECT *) ptr, *k, flag);
}
/*
********************************************************************************
*$ Component_name:
* FPro_SeriesIndices (series.c)
*$ Abstract:
* This routine returns the limiting index values for a series.
*$ Keywords:
* PROFILE, SERIES
* FORTRAN, PUBLIC, SUBROUTINE
*$ Declarations:
* integer*4 function FPro_SeriesIndices(object, k1, k2)
* integer*4 object, k1, k2
*$ Inputs:
* object FORTRAN pointer to a series object.
*$ Outputs:
* k1 lower index; unchanged on error.
* k2 upper index; unchanged on error.
*$ Returns:
* number of samples, i.e. k2 - k1 + 1; 0 on error.
*$ Detailed_description:
* This routine returns the limiting index values for a series.
*$ External_references:
* Profile toolkit
*$ Side_effects:
* none
*$ Examples:
* Suppose we have a series with six samples, such that series(k) = k for
* 0 <= k <= 5.
*
* Then FPro_SeriesIndices(series, k1, k2) sets k1=0, k2=5 and returns 6.
*$ Error_handling:
* Profile toolkit error handling is in effect.
*
* Conditions raised:
* PRO_CLASS_ERROR if object is NULL or 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
* 1.1: October 1999
*$ Change_history:
* 1.1: QUICK mode compile option added.
*******************************************************************************/
RL_INT4 FORTRAN_NAME(fpro_seriesindices) (object, k1, k2)
RL_INT4 *object, *k1, *k2;
{
RL_VOID *ptr;
/* Look up series pointer */
ptr = FORT_GetPointer(*object);
#ifndef QUICK
if (ptr == NULL) return 0;
#endif
return Pro_SeriesIndices((PRO_OBJECT *) ptr, k1, k2);
}
/*
********************************************************************************
*$ Component_name:
* FPro_SeriesSampling (series.c)
*$ Abstract:
* This routine returns the sampling variable limits and interval for a
* series.
*$ Keywords:
* PROFILE, SERIES
* FORTRAN, PUBLIC, SUBROUTINE
*$ Declarations:
* real*8 function FPro_SeriesSampling(object, x1, x2, dx)
* integer*4 object
* real*8 x1, x2, dx
*$ Inputs:
* object FORTRAN pointer to a series object.
*$ Outputs:
* x1 lower limit (corresponding to index k1).
* x2 upper limit (corresponding to index k2).
* dx interval between successive samples.
*$ Returns:
* size of the x-range, i.e. (x2 - x1), or 0. on error.
*$ Detailed_description:
* This routine returns the sampling variable limits and interval for a
* series.
*
* The sampling variable is a double-precision quantity that varies in
* direct proportion to the sample index. It often relates the index to a
* specific physical quantity such as time or radius in a series.
*$ External_references:
* Profile toolkit
*$ Side_effects:
* none
*$ Examples:
* Suppose we have a series with six samples, such that series(k) = k for
* 0 <= k <= 5. The series samples are (0.11, 0.22, 0.33, 0.44, 0.55,
* 0.66)
*
* Then FPro_SeriesSampling(series, x1, x2, dx) sets x1=0.11d0, x2=0.66d0,
* dx=0.11d0, and returns 0.55d0.
*$ Error_handling:
* Profile toolkit error handling is in effect.
*
* Conditions raised:
* PRO_CLASS_ERROR if object is NULL or 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
* 1.1: October 1999
*$ Change_history:
* 1.1: QUICK mode compile option added.
*******************************************************************************/
RL_FLT8 FORTRAN_NAME(fpro_seriessampling) (object, x1, x2, dx)
RL_INT4 *object;
RL_FLT8 *x1, *x2, *dx;
{
RL_VOID *ptr;
/* Look up series pointer */
ptr = FORT_GetPointer(*object);
#ifndef QUICK
if (ptr == NULL) return 0.;
#endif
return Pro_SeriesSampling((PRO_OBJECT *) ptr, x1, x2, dx);
}
/*
********************************************************************************
*$ Component_name:
* FPro_SeriesIndex (series.c)
*$ Abstract:
* This routine converts a series sampling value to an index.
*$ Keywords:
* PROFILE, SERIES
* FORTRAN, PUBLIC, SUBROUTINE
*$ Declarations:
* real*8 function FPro_SeriesIndex(object, x)
* integer*4 object
* real*8 x
*$ Inputs:
* object FORTRAN pointer to a series object.
* x sampling parameter value.
*$ Outputs:
* none
*$ Returns:
* index value as a double-precision value.
*$ Detailed_description:
* This routine converts a series sampling value to an index. The value
* returned is in double precision and may need to be converted to an
* integer before use.
*
* The sampling variable is a double-precision quantity that varies in
* direct proportion to the sample index. It often relates the index to a
* specific physical quantity such as time or radius in a series.
*$ External_references:
* Profile toolkit
*$ Side_effects:
* none
*$ Examples:
* Suppose we have a series with six samples, such that series(k) = k for
* 0 <= k <= 5. The series samples are (0.11, 0.22, 0.33, 0.44, 0.55,
* 0.66)
*
* Then FPro_SeriesIndex(series, 0.22d0) returns 1.d0;
* FPro_SeriesIndex(series, 0.33d0) returns 2.d0;
* FPro_SeriesIndex(series, 0.275d0) returns 1.5d0.
*$ Error_handling:
* Profile toolkit error handling is in effect.
*
* Conditions raised:
* PRO_CLASS_ERROR if object is NULL or 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
* 1.1: October 1999
*$ Change_history:
* 1.1: QUICK mode compile option added.
*******************************************************************************/
RL_FLT8 FORTRAN_NAME(fpro_seriesindex) (object, x)
RL_INT4 *object;
RL_FLT8 *x;
{
RL_VOID *ptr;
/* Look up series pointer */
ptr = FORT_GetPointer(*object);
#ifndef QUICK
if (ptr == NULL) return 0.;
#endif
return Pro_SeriesIndex((PRO_OBJECT *) ptr, *x);
}
/*
********************************************************************************
*$ Component_name:
* FPro_SeriesXValue (series.c)
*$ Abstract:
* This routine converts a series index to a sampling parameter value.
*$ Keywords:
* PROFILE, SERIES
* FORTRAN, PUBLIC, SUBROUTINE
*$ Declarations:
* real*8 function FPro_SeriesXValue(object, k)
* integer*4 object
* real*8 k
*$ Inputs:
* object FORTRAN pointer to a series object.
* k index value (double precision).
*$ Outputs:
* none
*$ Returns:
* sampling parameter value.
*$ Detailed_description:
* This routine converts a series index to a sampling parameter value.
* The index value must be given in double precision, not integer format.
*
* The sampling variable is a double-precision quantity that varies in
* direct proportion to the sample index. It often relates the index to a
* specific physical quantity such as time or radius in a series.
*$ External_references:
* Profile toolkit
*$ Side_effects:
* none
*$ Examples:
* Suppose we have a series with six samples, such that series(k) = k for
* 0 <= k <= 5. The series samples are (0.11, 0.22, 0.33, 0.44, 0.55,
* 0.66)
*
* Then FPro_SeriesXValue(series, 1.d0) returns 0.22d0;
* FPro_SeriesXValue(series, 2.d0) returns 0.33d0;
* FPro_SeriesXValue(series, 1.5d0) returns 0.275d0.
*$ Error_handling:
* Profile toolkit error handling is in effect.
*
* Conditions raised:
* PRO_CLASS_ERROR if object is NULL or 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
* 1.1: October 1999
*$ Change_history:
* 1.1: QUICK mode compile option added.
*******************************************************************************/
RL_FLT8 FORTRAN_NAME(fpro_seriesxvalue) (object, k)
RL_INT4 *object;
RL_FLT8 *k;
{
RL_VOID *ptr;
/* Look up series pointer */
ptr = FORT_GetPointer(*object);
#ifndef QUICK
if (ptr == NULL) return 0.;
#endif
return Pro_SeriesXValue((PRO_OBJECT *) ptr, *k);
}
/*
********************************************************************************
*$ Component_name:
* FPro_WindowSeries (series.c)
*$ Abstract:
* This routine returns a new series object with a different index range
* than the original series.
*$ Keywords:
* PROFILE, SERIES
* FORTRAN, PUBLIC, SUBROUTINE
*$ Declarations:
* integer*4 function FPro_WindowSeries(object, k1, k2)
* integer*4 object, k1, k2
*$ Inputs:
* object FORTRAN pointer to a series object.
* k1 new lower index (inclusive).
* k2 new upper index (inclusive).
*$ Outputs:
* none
*$ Returns:
* FORTRAN pointer to a new series object, or 0 on non-fatal error.
*$ Detailed_description:
* This routine returns a new series object with a different index range
* than the original series. The new domain is generally narrower than the
* original but need not be; the intersection of the two ranges is used and
* samples for which no value exists are flagged as missing (see
* Pro_SeriesValue).
*$ External_references:
* Profile toolkit
*$ Side_effects:
* none
*$ Examples:
* Suppose we have a series with six samples, such that series(k) = k for
* 1 <= k <= 5 and series[6] is invalid.
*
* Then FPro_WindowSeries(series, 3, 7) creates a new series with 4
* samples, such that series(k) = k for 3 <= k <= 5 and series(6) is
* invalid. Any other value of k raises PRO_DOMAIN_ERROR.
*$ Error_handling:
* Profile toolkit error handling is in effect.
*
* Conditions raised:
* PRO_CLASS_ERROR if object is NULL or not a series.
* PRO_EMPTY_DOMAIN if the windowed series would have an empty
* domain.
* RL_MEMORY_ERROR on memory allocation failure.
* 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_windowseries) (object, k1, k2)
RL_INT4 *object, *k1, *k2;
{
RL_VOID *ptr1, *ptr2;
RL_INT4 index;
/* Look up series pointer */
ptr1 = FORT_GetPointer(*object);
if (ptr1 == NULL) return 0;
/* Call function */
ptr2 = (RL_VOID *) Pro_WindowSeries((PRO_OBJECT *) ptr1, *k1, *k2);
if (ptr2 == NULL) return 0;
/* Save new pointer */
index = FORT_AddPointer(ptr2);
if (index == 0) Pro_FreeObject((PRO_OBJECT *) ptr2);
return index;
}
/*******************************************************************************
*/