/*
******************************************************************************** * 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 Rings Node, March 1998 *******************************************************************************/ #include*/#include #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; } /*******************************************************************************