/*
******************************************************************************** * column.c -- Routines for treating a PDS COLUMN object as a series. * * User routines: * Pro_ColumnSeries() creates a series object out of a specified * PDS-labeled COLUMN object. * * Mark Showalter & Neil Heather, PDS Ring-Moon Systems Node, March 1998 *******************************************************************************/ #include <stdio.h> #include <string.h> #include <math.h> #include "profile.h" #include "fortran.h" #include "oal.h" /************************* * Data type definitions * *************************/ typedef struct ZPRO_COLUMN_STRUCT { XPRO_CLASS class; PRO_OBJECT *label; ODLTREE tabletree, columntree; RL_INT4 table, column, item, items, row1, row2, rows; RL_INT4 k1, start, skip; RL_FLT8 missing, invalid, offset, scale; RL_BOOL isdouble; RL_FLT8 *(ddata[2]); RL_FLT4 *(sdata[2]); RL_INT4 buffer_rows, rowsegs[2]; } ZPRO_COLUMN; /******************** * Static variables * ********************/ static XPRO_CLASS column_class = {XPRO_COLUMN_CLASS, "PDS column", NULL}; /************************************ * Prototypes of internal functions * ************************************/ static RL_FLT8 ZPro_ColumnValue RL_PROTO((RL_VOID *pointer, RL_INT4 k, RL_INT4 *flag)); static void ZPro_FreeColumn RL_PROTO((RL_VOID *pointer)); static void ZPro_PrintColumn RL_PROTO((RL_VOID *pointer)); /* ******************************************************************************** * EXPORTED USER ROUTINES ******************************************************************************** *$ Component_name: * Pro_ColumnSeries (column.c) *$ Abstract: * This routine creates and returns a column series object. A column * series returns the values from a column of data found in a series or * table of a PDS-labeled data file. *$ Keywords: * PROFILE, SERIES * C, PUBLIC, SUBROUTINE *$ Declarations: * PRO_OBJECT *Pro_ColumnSeries(label, ntable, ncolumn, nitem, * row1, row2, k1, buffersize, usedouble) * PRO_OBJECT *label; * RL_INT4 ntable, ncolumn, nitem, row1, row2, k1, buffersize; * RL_BOOL usedouble; *$ Inputs: * label pointer to a PDS label object. * ntable table index in label. * ncolumn column index in label. * nitem item index [1...n] or 0 to use all items. * row1 first row to include (numbered from 1). * row2 last row to include (numbered from 1; 0 for all). * k1 starting index for series. * buffersize minimum number of samples to keep in internal buffer; * 0 to keep entire column in memory. * usedouble TRUE to save double precision values internally; * FALSE for single precision. *$ Outputs: * none *$ Returns: * pointer to a new column series object, or NULL on non-fatal error. *$ Detailed_description: * This routine creates and returns a column series object. A column * series returns the values from a column of data found in a series or * table of a PDS-labeled data file. * * For PDS SERIES objects, the SAMPLING_PARAMETER quantities in the label * define the sampling of the series. For PDS TABLE objects, the series * sampling parameter is assumed to be the row index, starting with 1. * * Note: The buffersize parameter enables the user to have access to a * finite subset of the array at any given time without the need to retain * the entire column in memory. Whenever an attempt is made to access a * sample not currently in memory, the needed segment of the data file is * read into memory. The buffersize parameter should be no smaller than * the difference between the first and last series samples needed at a * given time. For example, when convolving the data with a filter * function, the buffersize should be greater than or equal to the full * width of the filter used. *$ External_references: * Profile toolkit, Object Access library *$ Side_effects: * Memory is allocated. A link to the corresponding label object is * created. *$ Examples: * This snippet of code prints out the first three samples in the second * column of the first table in a PDS-labeled data file. * * label = Pro_OpenLabel("table.tab"); * ntable = 1; * ncolumn = 2; * nitem = 0; * k1 = 0; * column = Pro_ColumnSeries(label, ntable, ncolumn, nitem, * 1, 0, k1, 0, TRUE); * * printf("%g %g %g\n", Pro_SeriesValue(column,k1), * Pro_SeriesValue(column,k1+1), * Pro_SeriesValue(column,k1+2)); *$ Error_handling: * Profile library error handling is in effect. * * Conditions raised: * PRO_CLASS_ERROR if label is NULL or is not a label object. * PRO_DOMAIN_ERROR it ntable, ncolumn or nitem is out of range. * PRO_MEMORY_ERROR on memory allocation failure. * PRO_SETUP_FAILURE on any OA Library error. *$ 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_ColumnSeries(label, ntable, ncolumn, nitem, row1, row2, k1, buffersize, usedouble) PRO_OBJECT *label; RL_INT4 ntable, ncolumn, nitem, row1, row2, k1, buffersize; RL_BOOL usedouble; { PRO_OBJECT *new; ZPRO_COLUMN *column; RL_INT4 k2, rows, flag, oldtype; RL_FLT8 x1, x2, dx; RL_CHAR *xname, *yname; RL_BOOL status, olderror; ODLTREE nodes[1]; RL_VOID *pointer, *tableptr, *columnptr; /* Allocate new column structure */ column = (ZPRO_COLUMN *) XRL_Malloc(sizeof(ZPRO_COLUMN)); if (column == NULL) return NULL; /* Initialize structure */ column->class = column_class; column->label = label; column->table = ntable; column->column = ncolumn; column->k1 = k1; column->isdouble = usedouble; column->ddata[0] = NULL; column->ddata[1] = NULL; column->sdata[0] = NULL; column->sdata[1] = NULL; column->rowsegs[0] = 1; column->rowsegs[1] = 0; /* Get column info from label */ status = XPro_LabelInfo(label, ntable, ncolumn, &tableptr, &columnptr, &(column->rows), &(column->items), &x1, &x2, &dx, &xname, &yname, &(column->missing), &(column->invalid), &(column->offset), &(column->scale)); if (!status) { XRL_Free((RL_VOID *) column); return NULL; } column->tabletree = (ODLTREE) tableptr; column->columntree = (ODLTREE) columnptr; if (!usedouble) { if (column->missing != -HUGE_VAL) column->missing = (RL_FLT4) column->missing; if (column->invalid != -HUGE_VAL) column->invalid = (RL_FLT4) column->invalid; } /* Interpret row parameters */ if (row1 < 1 || row1 > column->rows) { XPro_IDomainError("first row index", label, 1, column->rows, row1); XRL_Free((RL_VOID *) column); return NULL; } if (row2 == 0) row2 = column->rows; if (row2 < row1 || row2 > column->rows) { XPro_IDomainError("last row index", label, row1, column->rows, row2); XRL_Free((RL_VOID *) column); return NULL; } column->row1 = row1; column->row2 = row2; /* Interpret item parameter */ if (nitem == 1 && column->items == 1) nitem = 0; if (nitem == 0) { dx /= column->items; k2 = k1 + (row2-row1+1) * column->items - 1; column->start = 0; column->skip = 1; } else { if (nitem < 1 || nitem > column->items) { XPro_IDomainError("item index", label, 1, column->items, nitem); XRL_Free((RL_VOID *) column); return NULL; } column->start = nitem-1; column->skip = column->items; k2 = k1 + row2 - row1; } column->item = nitem; column->k1 = k1; /* Determine number of rows to retain in cache */ rows = row2 - row1 + 1; if (buffersize <= 0) column->buffer_rows = rows; else if (column->skip > 1) column->buffer_rows = buffersize; else column->buffer_rows = (buffersize + column->items - 1) / column->items; if (column->buffer_rows > rows) column->buffer_rows = rows; /* Save any PRO_EVALUATION_FAILURE and record future ones */ olderror = RL_ClearError1("PRO_EVALUATION_FAILURE"); oldtype = RL_SetErrorType("PRO_EVALUATION_FAILURE", RL_RECORD); /* Fill first buffer and check for errors */ ZPro_ColumnValue((RL_VOID *) column, column->k1, &flag); status = RL_ClearError1("PRO_EVALUATION_FAILURE"); /* Raise PRO_SETUP_FAILURE if necessary */ if (status) { RL_RaiseError("PRO_SETUP_FAILURE", xpro_message); /* Note xpro_message is a global variable and is already loaded with the error message by Pro_ColumnValue() */ } /* Restore any PRO_EVALUATION_FAILURE */ if (olderror) RL_RaiseError("PRO_EVALUATION_FAILURE", ""); RL_SetErrorType("PRO_EVALUATION_FAILURE", oldtype); /* Free the object and return NULL on error */ if (status) { ZPro_FreeColumn((RL_VOID *) column); return NULL; } /* Create new object */ new = XPro_MakeSeries(k1, k2, x1, dx, ZPro_ColumnValue, ZPro_FreeColumn, ZPro_PrintColumn, (RL_VOID *) column); /* Enslave the label and check for error */ if (new != NULL && XPro_EnslaveObject(new, label)) { Pro_FreeObject(new); } /* Transfer coordinate names to new object */ Pro_RenameObject(new, 1, xname); Pro_RenameObject(new, 2, yname); return new; } /* ******************************************************************************** * INTERNAL FUNCTIONS ******************************************************************************** * ZPro_ColumnValue(pointer, k, flag) * * This is the series evaluation function for a PDS column series object. It * checks to see if the sample is in the buffer, and reads a new section of the * data file if necessary. * * Inputs: * pointer pointer to the ZPRO_COLUMN 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 column at given index; 0. on error. * * Errors: * PRO_EVALUATION_FAILURE if an I/O occurs during file access. *******************************************************************************/ static RL_FLT8 ZPro_ColumnValue(pointer, k, flag) RL_VOID *pointer; RL_INT4 k, *flag; { ZPRO_COLUMN *column; RL_INT4 rowrel, rowseg, rowbase, rowmod, row1, row2, offset; RL_FLT8 value; RL_VOID *array; RL_CHAR *verb; OA_OBJECT oaobject, oaconvert; column = (ZPRO_COLUMN *) pointer; /*************************************** * Identify needed segment of the file * ***************************************/ rowrel = (k - column->k1) * column->skip/column->items; rowseg = rowrel / column->buffer_rows; rowbase = rowseg * column->buffer_rows; rowmod = rowseg & 1; /* * Explanation... * * rowrel is the desired sample's row relative to the first row used by * this column object. * rowseg is the segment index. This is 0 for the first set of * <buffer_rows> rows in the file, 1 for the second set, etc. * rowbase is the first row in the segment, relative to the first row used. * rowmod is 0 if rowseg is even; 1 if it is odd. This enables the routine * to keep two different segments in memory simultaneously. */ /***************************************** * Load segment into memory if necessary * *****************************************/ if (rowseg != column->rowsegs[rowmod]) { column->rowsegs[rowmod] = rowseg; /* Read segment of column from PDS file */ row1 = column->row1 + rowbase; row2 = row1 + column->buffer_rows - 1; if (row2 > column->row2) row2 = column->row2; #ifdef DEBUG printf("Reading rows %d to %d\n", row1, row2); #endif oaobject = OaReadSubTable(column->tabletree, (long) row1, (long) row2, &(column->columntree), 1); if (oaobject == NULL || (oa_errno >= 500 && oa_errno < 900)) { verb = "reading"; goto OAFAILURE; } /* Convert the data */ if (column->isdouble) { oaconvert = OaConvertObjecttoOneType(oaobject, "double", 0, FALSE); } else { oaconvert = OaConvertObjecttoOneType(oaobject, "float", 0, FALSE); } if (oaconvert == NULL || (oa_errno >= 500 && oa_errno < 900)) { verb = "converting"; goto OAFAILURE; } /* Export the data */ array = OaExportObject(oaconvert); if (column->isdouble) { XRL_Free((RL_VOID *) column->ddata[rowmod]); column->ddata[rowmod] = (RL_FLT8 *) array; } else { XRL_Free((RL_VOID *) column->sdata[rowmod]); column->sdata[rowmod] = (RL_FLT4 *) array; } if (pointer == NULL || (oa_errno >= 500 && oa_errno < 900)) { verb = "exporting"; goto OAFAILURE; } /* Delete the unconverted object */ (void) OaDeleteObject(oaobject); if (oa_errno >= 500 && oa_errno < 900) { verb = "deleting"; goto OAFAILURE; } } /******************************* * Extract sample from segment * *******************************/ offset = (k - column->k1)*column->skip - rowbase * column->items + column->start; if (column->isdouble) { if (column->ddata == NULL) goto INVALID; /* if I/O error occurred */ value = (column->ddata[rowmod])[offset]; } else { if (column->sdata == NULL) goto INVALID; /* if I/O error occurred */ value = (RL_FLT8) (column->sdata[rowmod])[offset]; } /* Check for flags */ if (value == column->missing) goto MISSING; if (value == column->invalid) goto INVALID; /* Return valid value */ *flag = 0; return value * column->scale + column->offset; OAFAILURE: (void) sprintf(xpro_message, "error %s PDS column object\n\ OA Library error code %d", verb, oa_errno); RL_RaiseError("PRO_EVALUATION_FAILURE", xpro_message); goto INVALID; INVALID: *flag = PRO_INVALID_FLAG; return 0.; MISSING: *flag = PRO_MISSING_FLAG; return 0.; } /* ******************************************************************************** * ZPro_FreeColumn(pointer) * * This is the freeing function for a PDS column series object. * * Inputs: * pointer pointer to the ZPRO_COLUMN data structure. *******************************************************************************/ static void ZPro_FreeColumn(pointer) RL_VOID *pointer; { ZPRO_COLUMN *column; RL_FLT8 value; column = (ZPRO_COLUMN *) pointer; XRL_Free((RL_VOID *) column->ddata[0]); XRL_Free((RL_VOID *) column->ddata[1]); XRL_Free((RL_VOID *) column->sdata[0]); XRL_Free((RL_VOID *) column->sdata[1]); XRL_Free(pointer); } /* ******************************************************************************** * ZPro_PrintColumn(pointer) * * This is the series printing function for a PDS series object. * * Inputs: * pointer pointer to the ZPRO_COLUMN data structure. *******************************************************************************/ static void ZPro_PrintColumn(pointer) RL_VOID *pointer; { ZPRO_COLUMN *column; RL_INT4 k; column = (ZPRO_COLUMN *) pointer; /* Make sure object is not NULL */ if (column == NULL) { printf("PRINT ERROR: PDS column series pointer is NULL\n"); return; } /* Make sure object is a PDS series */ if (column->class.id != XPRO_COLUMN_CLASS) { printf("PRINT ERROR: Object is not a PDS column series\n"); return; } /* Print object info... */ printf("\nPDS column series parameters...\n"); printf(" label = "); XPro_PrintInfo(column->label); printf(" table = %d\n", column->table); printf(" column = %d\n", column->column); if (column->items == 1) { printf(" item = 1 of 1\n"); } else if (column->item == 0) { printf(" item = all of %d\n", column->items); } else { printf(" item = %d of %d\n", column->item, column->items); } printf(" rows = %1d to %1d of %1d\n", column->row1, column->row2, column->rows); printf("precision = %s\n", column->isdouble ? "double":"single"); if (column->missing != -HUGE_VAL) printf(" missing = %#g\n", column->missing); if (column->invalid != -HUGE_VAL) printf(" invalid = %#g\n", column->invalid); if (column->scale != 1. && column->offset != 0.) printf(" scaling = %#g * x + %#g\n", column->scale, column->offset); } /* ******************************************************************************** * FORTRAN INTERFACE ROUTINES ******************************************************************************** *$ Component_name: * FPro_ColumnSeries (column.c) *$ Abstract: * This routine creates and returns a column series object. A column * series returns the values from a column of data found in a series or * table of a PDS-labeled data file. *$ Keywords: * PROFILE, SERIES * FORTRAN, PUBLIC, SUBROUTINE *$ Declarations: * integer*4 function FPro_ColumnSeries(label, table, column, item, * row1, row2, k1, buffersize, usedouble) * integer*4 label, table, column, item, row1, row2, k1, buffersize * logical*4 usedouble *$ Inputs: * label FORTRAN pointer to a PDS label object. * ntable table index in label. * ncolumn column index in label. * nitem item index [1...n] or 0 to use all items. * row1 first row to include (numbered from 1). * row2 last row to include (numbered from 1; 0 for all). * k1 starting index for series. * buffersize minimum number of samples to keep in internal buffer; * 0 to keep entire column in memory. * usedouble TRUE to save double precision values internally; * FALSE for single precision. *$ Outputs: * none *$ Returns: * FORTRAN pointer to a new column series object, or NULL on non-fatal * error. *$ Detailed_description: * This routine creates and returns a column series object. A column * series returns the values from a column of data found in a series or * table of a PDS-labeled data file. * * For PDS SERIES objects, the SAMPLING_PARAMETER quantities in the label * define the sampling of the series. For PDS TABLE objects, the series * sampling parameter is assumed to be the row index, starting with 1. * * Note: The buffersize parameter enables the user to have access to a * finite subset of the array at any given time without the need to retain * the entire column in memory. Whenever an attempt is made to access a * sample not currently in memory, the needed segment of the data file is * read into memory. The buffersize parameter should be no smaller than * the difference between the first and last series samples needed at a * given time. For example, when convolving the data with a filter * function, the buffersize should be greater than or equal to the full * width of the filter used. *$ External_references: * Profile toolkit, Object Access library *$ Side_effects: * Memory is allocated. A link to the corresponding label object is * created. *$ Examples: * This snippet of code prints out the first three samples in the second * column of the first table in a PDS-labeled data file. * * label = Pro_OpenLabel('table.tab') * ntable = 1 * ncolumn = 2 * nitem = 0 * k1 = 0 * column = FPro_ColumnSeries(label, ntable, ncolumn, nitem, * & 1, 0, k1, 0, .TRUE.) * * write(*,*) FPro_SeriesValue(column,k1), * & FPro_SeriesValue(column,k1+1), * & FPro_SeriesValue(column,k1+2) *$ Error_handling: * Profile library error handling is in effect. * * Conditions raised: * PRO_CLASS_ERROR if label is NULL or is not a label object. * PRO_DOMAIN_ERROR it ntable, ncolumn or nitem is out of range. * PRO_MEMORY_ERROR on memory allocation failure. * PRO_SETUP_FAILURE on any OA Library error. * FORTRAN_POINTER_ERROR if label 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_columnseries) (label, table, column, item, row1, row2, k1, buffersize, usedouble) RL_INT4 *label, *table, *column, *item, *row1, *row2, *k1, *buffersize, *usedouble; { RL_VOID *ptr1, *ptr2; RL_INT4 index; /* Look up label pointer */ ptr1 = FORT_GetPointer(*label); if (ptr1 == NULL) return 0; /* Call function */ ptr2 = (RL_VOID *) Pro_ColumnSeries(ptr1, *table, *column, *item, *row1, *row2, *k1, *buffersize, (RL_BOOL) *usedouble); if (ptr2 == NULL) return 0; index = FORT_AddPointer(ptr2); if (index == 0) Pro_FreeObject((PRO_OBJECT *) ptr2); return index; } /********************************************************************************/