/* array.c
********************************************************************************
* array.c -- Routines for array series objects.
*
* User routines:
* Pro_ArraySeries() creates a series object out of an internal
* array of values.
*
* Mark Showalter & Neil Heather, PDS Ring-Moon Systems Node, March 1998
*******************************************************************************/
#include <stdio.h>
#include <string.h>
#include "profile.h"
#include "fortran.h"
/*************************
* Data type definitions *
*************************/
typedef struct ZPRO_ARRAY_STRUCT {
XPRO_CLASS class;
RL_INT4 kmin, kmax;
RL_BOOL isdouble, isduped;
RL_FLT8 missing, invalid;
RL_FLT4 *table1;
RL_FLT8 *table2;
} ZPRO_ARRAY;
/********************
* Static variables *
********************/
static XPRO_CLASS array_class = {XPRO_ARRAY_CLASS, "array", NULL};
/************************************
* Prototypes of internal functions *
************************************/
static RL_FLT8 ZPro_ArrayValue RL_PROTO((RL_VOID *pointer, RL_INT4 k,
RL_INT4 *flag));
static void ZPro_FreeArray RL_PROTO((RL_VOID *pointer));
static void ZPro_PrintArray RL_PROTO((RL_VOID *pointer));
/*
********************************************************************************
* EXPORTED USER ROUTINES
********************************************************************************
*$ Component_name:
* Pro_ArraySeries (array.c)
*$ Abstract:
* This routine creates and returns an array series object. An array
* series is one in which the sample values have been stored in a table in
* memory by the user.
*$ Keywords:
* PROFILE, SERIES
* C, PUBLIC, SUBROUTINE
*$ Declarations:
* PRO_OBJECT *Pro_ArraySeries(table, k1, nsamples, x1, dx,
* missing, invalid, isdouble, dupe)
* RL_VOID table[];
* RL_INT4 k1, nsamples;
* RL_FLT8 x1, dx, missing, invalid;
* RL_BOOL isdouble, dupe;
*$ Inputs:
* table pointer to the first element of the sample array, in
* either single or double precision.
* k1 starting index.
* nsamples number of samples in table.
* x1 x-value of first sample in table.
* dx x-interval between consecutive samples.
* missing table value to indicate sample is missing.
* invalid table value to indicate sample is invalid.
* isdouble TRUE if table is in double precision; FALSE if it is in
* single precision.
* dupe TRUE to duplicate the array internally; FALSE to point
* to array provided by the user.
*$ Outputs:
* none
*$ Returns:
* pointer to a new array object, or NULL on non-fatal error.
*$ Detailed_description:
* This routine creates and returns an array series object. An array
* series is one in which the sample values have been stored in a table in
* memory by the user.
*$ External_references:
* Profile toolkit
*$ Side_effects:
* Memory is allocated.
*$ Examples:
* This snippet of code defines a series with seven samples with
* sequential values -1. through 5. It then converts the values to
* integers and writes them out on a single line. The result is
* -1 0 1 2 3 4 5
*
* PRO_OBJECT *series;
* RL_FLT8 numbers[] = {-1., 0., 1., 2., 3., 4., 5.};
* RL_INT4 k;
*
* \* Create a series that returns -1 through 5 *\
* series = Pro_ArraySeries(numbers, 1, 7, 1., 1.,
* -999., -999., TRUE, FALSE);
* \* Print values *\
* for (k=1; k<=7; k++)
* printf("%1d ", (RL_INT4) Pro_SeriesValue(series,k));
* printf("\n");
*
*$ Error_handling:
* Profile toolkit error handling is in effect.
*
* Conditions raised:
* 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_ArraySeries(table, k1, nsamples, x1, dx, missing, invalid,
isdouble, dupe)
RL_VOID *table;
RL_INT4 k1, nsamples;
RL_FLT8 x1, dx, missing, invalid;
RL_BOOL isdouble, dupe;
{
ZPRO_ARRAY *array;
PRO_OBJECT *new;
RL_INT4 i, size;
RL_VOID *temp;
RL_FLT4 *temp1;
RL_FLT8 *temp2;
/* Allocate new array structure */
array = (ZPRO_ARRAY *) XRL_Malloc(sizeof(ZPRO_ARRAY));
if (array == NULL) return NULL;
/* Initialize structure */
array->class = array_class;
array->kmin = k1;
array->kmax = k1 + nsamples - 1;
array->isdouble = isdouble;
array->missing = isdouble ? missing : (RL_FLT4) missing;
array->invalid = isdouble ? invalid : (RL_FLT4) invalid;
array->table1 = NULL;
array->table2 = NULL;
/* Allocate table if necessary */
if (dupe) {
size = isdouble ? sizeof(RL_FLT8) : sizeof(RL_FLT4);
temp = XRL_Malloc(nsamples * size);
if (temp == NULL) {
XRL_Free((RL_VOID *) array);
return NULL;
}
}
else {
temp = table;
}
/* Save pointer */
if (isdouble) array->table2 = (RL_FLT8 *) temp;
else array->table1 = (RL_FLT4 *) temp;
/* Copy data into table if necessary */
if (dupe) {
if (isdouble) {
temp2 = (RL_FLT8 *) table;
for (i = 0; i < nsamples; i++) (array->table2)[i] = temp2[i];
}
else {
temp1 = (RL_FLT4 *) table;
for (i = 0; i < nsamples; i++) (array->table1)[i] = temp1[i];
}
}
array->isduped = dupe;
/* Create new object */
new = XPro_MakeSeries(array->kmin, array->kmax, x1, dx,
ZPro_ArrayValue, ZPro_FreeArray, ZPro_PrintArray,
(RL_VOID *) array);
return new;
}
/*
********************************************************************************
* INTERNAL FUNCTIONS
********************************************************************************
* ZPro_ArrayValue(pointer, k, flag)
*
* This is the series evaluation function for an array series object.
*
* Inputs:
* pointer pointer to the ZPRO_ARRAY data structure.
* k index at which to evaluate array.
*
* Outputs:
* flag 0 if value returned is valid; PRO_MISSING_FLAG if it is
* missing; PRO_INVALID_FLAG if it is invalid.
*
* Return: value of array at given index; 0. on error.
*******************************************************************************/
static RL_FLT8 ZPro_ArrayValue(pointer, k, flag)
RL_VOID *pointer;
RL_INT4 k, *flag;
{
ZPRO_ARRAY *array;
RL_FLT8 value;
array = (ZPRO_ARRAY *) pointer;
/* Make sure k is inside domain */
if (k < array->kmin || k > array->kmax) {
*flag = PRO_MISSING_FLAG;
return 0.;
}
/* Look up value in array */
if (array->isdouble) value = (array->table2)[k - array->kmin];
else value = (array->table1)[k - array->kmin];
/* Check for flags */
if (value == array->missing) {
*flag = PRO_MISSING_FLAG;
return 0.;
}
if (value == array->invalid) {
*flag = PRO_INVALID_FLAG;
return 0.;
}
/* Return value and normal flag */
*flag = 0;
return value;
}
/*
********************************************************************************
* ZPro_FreeArray(pointer)
*
* This is the series freeing function for an array series object.
*
* Inputs:
* pointer pointer to the ZPRO_ARRAY data structure.
*******************************************************************************/
static void ZPro_FreeArray(pointer)
RL_VOID *pointer;
{
ZPRO_ARRAY *array;
array = (ZPRO_ARRAY *) pointer;
if (array->isduped) {
XRL_Free((RL_VOID *) array->table1);
XRL_Free((RL_VOID *) array->table2);
}
XRL_Free(pointer);
}
/*
********************************************************************************
* ZPro_PrintArray(pointer)
*
* This is the series printing function for an array series object.
*
* Inputs:
* pointer pointer to the ZPRO_ARRAY data structure.
*******************************************************************************/
static void ZPro_PrintArray(pointer)
RL_VOID *pointer;
{
ZPRO_ARRAY *array;
RL_INT4 k;
array = (ZPRO_ARRAY *) pointer;
/* Make sure object is not NULL */
if (array == NULL) {
printf("PRINT ERROR: Array series pointer is NULL\n");
return;
}
/* Make sure object is an array series */
if (array->class.id != XPRO_ARRAY_CLASS) {
printf("PRINT ERROR: Object is not an array series\n");
return;
}
/* Print object info... */
printf("\nArray series parameters...\n");
printf("missing flag = %#g\n", array->missing);
printf("invalid flag = %#g\n", array->invalid);
printf(" precision = %s\n", array->isdouble ? "double" : "single");
printf(" duplicated = %s\n", array->isduped ? "true" : "false");
for (k = array->kmin; k <= array->kmin+5 && k <= array->kmax; k++)
printf(" array[%1d] = %#g\n", k,
array->isdouble ? (array->table2)[k - array->kmin] :
(array->table1)[k - array->kmin]);
}
/*
********************************************************************************
* FORTRAN INTERFACE ROUTINES
********************************************************************************
*$ Component_name:
* FPro_ArraySeries (array.c)
*$ Abstract:
* This routine creates and returns an array series object. An array
* series is one in which the sample values have been stored in a table in
* memory by the user.
*$ Keywords:
* PROFILE, SERIES
* FORTRAN, PUBLIC, SUBROUTINE
*$ Declarations:
* integer*4 function FPro_ArraySeries(table, k1, nsamples, x1, dx,
* missing, invalid, isdouble, dupe)
* real*(4 or 8) table(*)
* real*8 table(*), x1, dx, missing, invalid
* integer*4 k1, nsamples
* logical*4 isdouble, dupe
*$ Inputs:
* table(*) table of series samples, in either single or double
* precision.
* k1 starting index.
* nsamples number of samples in table.
* x1 x-value of first sample in table.
* dx x-interval between consecutive samples.
* missing value in table to indicate sample is missing.
* invalid value to table to indicate sample is invalid.
* isdouble .TRUE. if table is in double precision; .FALSE. if it
* is single precision.
* dupe .TRUE. to duplicate the table internally; .FALSE. to
* point to the table provided by the user;
*$ Outputs:
* none
*$ Returns:
* FORTRAN pointer to a new series object, or 0 on non-fatal error.
*$ Detailed_description:
* This routine creates and returns an array series object. An array
* series is one in which the sample values have been stored in a table in
* memory by the user.
*$ External_references:
* Profile toolkit
*$ Side_effects:
* Memory is allocated.
*$ Examples:
* This snippet of code defines a series with seven samples with
* sequential values -1. through 5. It then write out each value.
* integer and writes it out. The result is
* -1.00
* 0.00
* 1.00
* 2.00
* 3.00
* 4.00
* 5.00
*
* integer*4 series, k
* real*8 numbers(7)/ -1., 0., 1., 2., 3., 4., 5. /
*
* series = FPro_ArraySeries(numbers, 1, 7, 1.d0, 1.d0,
* -999.d0, -999.d0, .TRUE., .FALSE.)
*
* do 100 k = 1, 7
* write(*,'(1x,f5.2)') FPro_SeriesValue(series,k)
* 100 continue
*
*$ Error_handling:
* Profile toolkit error handling is in effect.
*
* Conditions raised:
* PRO_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
*******************************************************************************/
RL_INT4 FORTRAN_NAME(fpro_arrayseries) (table, k1, nsamples, x1, dx,
missing, invalid, isdouble, dupe)
RL_VOID *table;
RL_INT4 *k1, *nsamples, *isdouble, *dupe;
RL_FLT8 *x1, *dx, *missing, *invalid;
{
RL_VOID *ptr;
RL_INT4 index;
ptr = (RL_VOID *) Pro_ArraySeries(table, *k1, *nsamples, *x1, *dx,
*missing, *invalid,
(RL_BOOL) *isdouble, (RL_BOOL) *dupe);
if (ptr == NULL) return 0;
index = FORT_AddPointer(ptr);
if (index == 0) Pro_FreeObject((PRO_OBJECT *) ptr);
return index;
}
/*******************************************************************************
*/