/*
******************************************************************************** * curve.c -- Routines for curve function objects * * User routines * Pro_CurveValue() returns the value and slope of a curve. * Pro_CurveInverse() evaluates the inverse value of a curve. * Pro_CurveSegments() returns the number of "segments" (i.e. monotonic * subregions) within the domain of a curve. * Pro_CurveExtremum() returns the extreme value at a boundary between * segments. * * Programmer routines * XPro_MakeCurve() used to create a new curve object. * XPro_CurvePtr() returns a pointer to the sub-object. * * Version 1.0: Original release. * Mark Showalter, PDS Rings Node, March 1998. * Version 1.1: QUICK compilation mode added. * Mark Showalter, October 1999. *******************************************************************************/ #include*/#include "profile.h" #include "fortran.h" /******************** * Type definitions * ********************/ typedef struct ZPRO_CURVE_STRUCT { XPRO_CLASS class; RL_INT4 nsegments; struct ZPRO_SEGMENT_STRUCT {RL_FLT8 x, y; RL_INT4 type;} *segments; RL_FLT8 (*evalfunc) RL_PROTO((RL_VOID *pointer, RL_FLT8 x, RL_FLT8 *slope)); RL_FLT8 (*invfunc) RL_PROTO((RL_VOID *pointer, RL_FLT8 y, RL_FLT8 x1, RL_FLT8 x2)); void (*freefunc) RL_PROTO((RL_VOID *pointer)); void (*printfunc) RL_PROTO((RL_VOID *pointer)); } ZPRO_CURVE; typedef struct ZPRO_SEGMENT_STRUCT ZPRO_SEGMENT; /******************** * Static variables * ********************/ static RL_INT4 seg1, seg2; /* Values retained from most recent call to Pro_CurveSegments(). They can then be used by Pro_CurveExtremum() */ static XPRO_CLASS curve_class = {XPRO_CURVE_CLASS, "curve", NULL}; /******************************** * Internal function prototypes * ********************************/ static RL_FLT8 ZPro_CurveValue RL_PROTO((RL_VOID *pointer, RL_FLT8 x)); static RL_FLT8 ZPro_CurveSlope RL_PROTO((RL_VOID *pointer, RL_FLT8 x)); static void ZPro_FreeCurve RL_PROTO((RL_VOID *pointer)); static void ZPro_PrintCurve RL_PROTO((RL_VOID *pointer)); static void ZPro_PrintSlope RL_PROTO((RL_VOID *pointer)); static ZPRO_CURVE *ZPro_GetCurve RL_PROTO((PRO_OBJECT *object)); /********** * Macros * **********/ #define ISIGN(x) ((x) < 0. ? -1 : ((x) == 0. ? 0 : 1)) #ifdef QUICK #define ZPro_GetCurve(object) ((ZPRO_CURVE *) XPro_SeriesPtr(object)) #endif /* ******************************************************************************** * EXPORTED USER ROUTINES ******************************************************************************** *$ Component_name: * Pro_CurveValue (curve.c) *$ Abstract: * This routine returns the value and slope of a curve at a given location. *$ Keywords: * PROFILE, FUNCTION, CURVE * C, PUBLIC, SUBROUTINE *$ Declarations: * RL_FLT8 Pro_CurveValue(object, x, slope) * PRO_OBJECT *object; * RL_FLT8 x, *slope; *$ Inputs: * object pointer to the curve object. * x location at which to evaluate curve. *$ Outputs: * *slope slope of curve at x; not returned if slope==NULL. * Zero is returned on non-fatal error. *$ Returns: * value of curve at argument. Zero is returned on a non-fatal class * error; the value at the nearest endpoint of the domain is returned on a * non-fatal domain error. *$ Detailed_description: * This routine returns the value and (optionally) slope of a curve at a * given location. A curve object extends the properties of a function * object in that it has a continuous, calculable slope. *$ External_references: * Profile toolkit *$ Side_effects: * none *$ Examples: * Suppose square is a curve that returns x squared between -3. and 3. * * Then Pro_CurveValue(square, 3., &dydx) returns 9. and sets dydx to 6. *$ Error_handling: * Profile library error handling is in effect. * * Conditions raised: * PRO_CLASS_ERROR if object is NULL or is not a curve. * PRO_DOMAIN_ERROR if x-value is outside the curve's domain. * PRO_EVALUATION_FAILURE if curve could not be evaluated. * * On a non-fatal PRO_DOMAIN_ERROR the value at the nearest endpoint is * returned; on other non-fatal errors, 0. is returned. In any case, the * value of the slope returned is zero. *$ 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_CurveValue(object, x, slope) PRO_OBJECT *object; RL_FLT8 x, *slope; { ZPRO_CURVE *curve; RL_FLT8 value, x1, x2; curve = ZPro_GetCurve(object); #ifndef QUICK if (curve == NULL) { if (slope != NULL) *slope = 0.; return 0.; } #endif /* Make sure x is inside domain */ #ifdef QUICK x1 = object->x1; x2 = object->x2; #else (void) Pro_ObjectDomain(object, &x1, &x2); #endif if (x < x1 || x > x2) { XPro_DomainError("x value", object, x1, x2, x); /* Evaluate function at nearest endpoint */ if (x < x1) value = (curve->evalfunc)(curve->class.pointer, x1, NULL); else value = (curve->evalfunc)(curve->class.pointer, x2, NULL); /* Set slope to zero since value is constant outside domain */ if (slope != NULL) *slope = 0.; return value; } /* Return value of function */ return (curve->evalfunc)(curve->class.pointer, x, slope); } /* ******************************************************************************** *$ Component_name: * Pro_CurveInverse (curve.c) *$ Abstract: * This routine returns the inverse of the given curve. *$ Keywords: * PROFILE, FUNCTION, CURVE * C, PUBLIC, SUBROUTINE *$ Declarations: * RL_FLT8 Pro_CurveInverse(object, segment, y) * PRO_OBJECT *object; * RL_INT4 segment; * RL_FLT8 y; *$ Inputs: * object pointer to the curve object. * segment segment number in which to search. A segment is a * monotonic section of a curve, numbered starting at 1. * y value of curve sought. *$ Outputs: * none *$ Returns: * location within the segment where the curve equals the given y-value. * An error is raised if the curve cannot be inverted; if this condition is * non-fatal, the x-value at the endpoint with the closest y-value is * returned. *$ Detailed_description: * This routine returns the inverse of the given curve, i.e. the location * within the segment where the curve equals the given y-value. * * Inverses are calculated within a specified segment, which is a monotonic * section of a curve. Segments are separated by extrema and points of * inflection, where segment #1 runs from the lower endpoint to the first * extremum/inflection point, or to the upper endpoint if that comes first. * * An error is raised if the curve cannot be inverted; if this condition * is non-fatal, the x-value at the endpoint of the segment with the * closest y-value is returned. *$ External_references: * Profile toolkit *$ Side_effects: * none *$ Examples: * Suppose square is a curve that returns x squared between -3. and 3. * * Then Pro_CurveInverse(square, 1, 2.25) returns -1.5; * Pro_CurveInverse(square, 2, 2.25) returns 1.5; *$ Error_handling:Pro_CurveInverse(square, 1, 2.25) returns -1.5; * Profile library error handling is in effect. * * Conditions raised: * PRO_CLASS_ERROR if object is NULL or is not a curve. * PRO_DOMAIN_ERROR if the segment index is out of range for the * curve. * PRO_EVALUATION_FAILURE if curve could not be inverted. * * For a non-fatal PRO_CLASS_ERROR, zero is returned; for a non-fatal * PRO_DOMAIN_ERROR or PRO_EVALUATION_FAILURE, the x-value at the nearest * segment endpoint is returned. *$ 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_CurveInverse(object, segment, y) PRO_OBJECT *object; RL_INT4 segment; RL_FLT8 y; { ZPRO_CURVE *curve; RL_FLT8 x1, x2, value; RL_INT4 nsegments; curve = ZPro_GetCurve(object); #ifndef QUICK if (curve == NULL) return 0.; #endif x1 = Pro_CurveExtremum(object, segment-1, NULL, NULL); x2 = Pro_CurveExtremum(object, segment, NULL, NULL); value = (curve->invfunc)(curve->class.pointer, y, x1, x2); return value; } /* ******************************************************************************** *$ Component_name: * Pro_CurveSegments (curve.c) *$ Abstract: * This function returns the number of segments in the curve domain. A * segment is the region from one endpoint, extremum, or inflection point * to the next. *$ Keywords: * PROFILE, FUNCTION, CURVE * C, PUBLIC, SUBROUTINE *$ Declarations: * RL_INT4 Pro_CurveSegments(object) * PRO_OBJECT *object; *$ Inputs: * object pointer to the curve object. *$ Outputs: * none *$ Returns: * number of segments, or 0 on error. *$ Detailed_description: * This function returns the number of segments in the curve domain. A * segment is the region from one endpoint, extremum, or inflection point * to the next. *$ External_references: * Profile toolkit *$ Side_effects: * none *$ Examples: * Suppose square is a curve that returns x squared between -3. and 3. * * Then Pro_CurveSegments(square) returns 2. *$ Error_handling: * Profile library error handling is in effect. On non-fatal error, the * routine returns 0. * * Conditions raised: * PRO_CLASS_ERROR if object is NULL or is not a curve. *$ Limitations: * none *$ Author_and_institution: * Mark R. Showalter * NASA/Ames Research Center *$ Version_and_date: * 1.0: March 1998 *$ Change_history: * none *******************************************************************************/ RL_INT4 Pro_CurveSegments(object) PRO_OBJECT *object; { ZPRO_CURVE *curve; RL_INT4 segments; RL_FLT8 x1, x2; curve = ZPro_GetCurve(object); if (curve == NULL) return 0; /* Find segments where domain limits fall (and save as static variables) This is needed in case the curve has been windowed */ Pro_ObjectDomain(object, &x1, &x2); for (seg1 = 1; seg1 <= curve->nsegments; seg1++) if (x1 < curve->segments[seg1].x) break; seg1--; for (seg2 = curve->nsegments-1; seg2 > seg1; seg2--) if (x2 > curve->segments[seg2].x) break; seg2++; /* Calculate difference */ segments = seg2 - seg1; return segments; } /* ******************************************************************************** *$ Component_name: * Pro_CurveExtremum (curve.c) *$ Abstract: * This routine returns the location of the given extremum, inflection * point or domain endpoint. *$ Keywords: * PROFILE, FUNCTION, CURVE * C, PUBLIC, SUBROUTINE *$ Declarations: * RL_FLT8 Pro_CurveExtremum(object, segment, value, type) * PRO_OBJECT *object; * RL_INT4 segment, *type; * RL_FLT8 *value; *$ Inputs: * object pointer to the curve object. * segment segment number (0 to number of segments). *$ Outputs: * *value value of the curve at this location. Not returned if * value == NULL. * *type +1 if extremum is a local maximum; -1 if extremum is a * local minimum; 0 if extremum is an inflection point. * Not returned if type == NULL. *$ Returns: * location of extremum, or 0. on error. *$ Detailed_description: * This routine returns the location of the given extremum, inflection * point or domain endpoint. * * Points are identified by 0 through N, where N is the number of segments * in the curve. Here 0 and N refers to the lower and upper limits of the * domain, and 1 to N-1 refer to the local extrema and inflection points in * between. Hence, segment #n is bounded by points #n-1 and #n. *$ External_references: * Profile toolkit *$ Side_effects: * none *$ Examples: * Suppose square is a curve that returns x squared between -3. and 3. * * Then Pro_CurveExtremum(square, 0, &value, &type) returns -3., sets value * to 9. and sets type to +1 (maximum); * Pro_CurveExtremum(square, 1, &value, &type) returns 0., sets value * to 0. and sets type to -1 (minimum); * Pro_CurveExtremum(square, 2, &value, &type) returns 3., sets value * to 9. and sets type to +1 (maximum). *$ Error_handling: * Profile library error handling is in effect. On non-fatal error, the * routine returns 0. * * Conditions raised: * PRO_CLASS_ERROR if object is NULL or is not a curve. * PRO_DOMAIN_ERROR if the segment index is out of range for the * curve; in this case properties of the nearest * domain endpoint are returned. *$ Limitations: * none *$ Author_and_institution: * Mark R. Showalter * NASA/Ames Research Center *$ Version_and_date: * 1.0: March 1998 *$ Change_history: * none *******************************************************************************/ RL_FLT8 Pro_CurveExtremum(object, segment, value, type) PRO_OBJECT *object; RL_INT4 segment, *type; RL_FLT8 *value; { ZPRO_CURVE *curve; RL_INT4 nsegments; RL_FLT8 x1, x2, y; curve = ZPro_GetCurve(object); if (curve == NULL) return 0.; /* Note that this call also defines static variables seg1 and seg2 */ nsegments = Pro_CurveSegments(object); /* Check segment index */ if (segment < 0 || segment > nsegments) { XPro_IDomainError("extremum index", object, 0, nsegments, segment); } /* Handle domain boundary segments */ if (segment <= 0) { Pro_ObjectDomain(object, &x1, &x2); y = Pro_CurveValue(object, x1, NULL); if (value != NULL) *value = y; if (type != NULL) *type = ISIGN(y - curve->segments[seg1+1].y); return x1; } if (segment >= nsegments) { Pro_ObjectDomain(object, &x1, &x2); y = Pro_CurveValue(object, x2, NULL); if (value != NULL) *value = y; if (type != NULL) *type = ISIGN(y - curve->segments[seg2-1].y); return x2; } /* Adjust segment index in case function has been windowed */ segment += seg1; if (value != NULL) *value = curve->segments[segment].y; if (type != NULL) *type = curve->segments[segment].type; return curve->segments[segment].x; } /* ******************************************************************************** * PROGRAMMER ROUTINES ******************************************************************************** * XPro_MakeCurve(x1, x2, nextrema, xextrema, evalfunc, invfunc, freefunc, * printfunc, pointer) * * This routine creates and initializes a curve object. * * Inputs: * x1, x2 domain limits. * nextrema number of extrema in array xextrema[]. This list must * contain every extremum or inflection point at least * within the domain, in increasing order. * xextrema locations of extrema. * evalfunc routine to evaluate function. * invfunc routine to evaluate inverse of function. * freefunc routine to free data structure. * printfunc routine to print curve information. * pointer pointer to an arbitrary data structure describing the * curve. * * Returns: new curve object, or NULL on error. * * Errors: * RL_MEMORY_ERROR on memory allocation failure. *******************************************************************************/ PRO_OBJECT *XPro_MakeCurve(x1, x2, nextrema, xextrema, evalfunc, invfunc, freefunc, printfunc, pointer) RL_FLT8 x1, x2, *xextrema; RL_INT4 nextrema; RL_FLT8 (*evalfunc) RL_PROTO((RL_VOID *pointer, RL_FLT8 x, RL_FLT8 *slope)); RL_FLT8 (*invfunc) RL_PROTO((RL_VOID *pointer, RL_FLT8 y, RL_FLT8 x1, RL_FLT8 x2)); void (*freefunc) RL_PROTO((RL_VOID *pointer)); void (*printfunc) RL_PROTO((RL_VOID *pointer)); RL_VOID *pointer; { ZPRO_CURVE *curve; ZPRO_SEGMENT *segs; RL_INT4 i, j, type1, type2; PRO_OBJECT *new; /* Allocate new curve object from memory */ curve = (ZPRO_CURVE *) XRL_Malloc(sizeof(ZPRO_CURVE)); if (curve == NULL) return NULL; curve->segments = (ZPRO_SEGMENT *) XRL_Malloc((nextrema+2) * sizeof(ZPRO_SEGMENT)); if (curve->segments == NULL) { XRL_Free((RL_VOID *) curve); return NULL; } /* Fill in fields */ curve->class = curve_class; curve->class.pointer = pointer; curve->evalfunc = evalfunc; curve->invfunc = invfunc; curve->freefunc = freefunc; curve->printfunc = printfunc; /* Copy table of extreme x-values into segment structure */ segs = curve->segments; for (i=0; i x1) break; } for (j=1; i = x2) break; segs[j].x = xextrema[i]; } segs[0].x = x1; segs[j].x = x2; curve->nsegments = j; /* Fill in y-values */ for (j=0; j <= curve->nsegments; j++) { segs[j].y = (*evalfunc)(pointer, segs[j].x, NULL); } /* Fill in extremum types */ for (j=1; j < curve->nsegments; j++) { type1 = ISIGN(segs[j].y - segs[j-1].y); type2 = ISIGN(segs[j].y - segs[j+1].y); if (type1 == type2) segs[j].type = type1; else segs[j].type = 0; } j = curve->nsegments; segs[j].type = ISIGN(segs[j].y - segs[j-1].y); segs[0].type = ISIGN(segs[0].y - segs[1].y); /* Create new object */ new = XPro_MakeFunc(x1, x2, ZPro_CurveValue, ZPro_FreeCurve, ZPro_PrintCurve, (RL_VOID *) curve); return new; } /* ******************************************************************************** * XPro_CurvePtr(object) * * This routine returns a pointer to the curve sub-object. * * Inputs: * object curve object. * * Return: pointer field of the object; NULL on error. * * Errors: * PRO_CLASS_ERROR if the object is NULL or not a curve. ****************************************************************************/ #ifndef QUICK /* In QUICK mode, this is defined as a macro in profile.h */ RL_VOID *XPro_CurvePtr(object) PRO_OBJECT *object; { ZPRO_CURVE *curve; curve = ZPro_GetCurve(object); if (curve == NULL) return NULL; if (curve->class.pointer == NULL) XPro_NullError("curve sub-object", object); return curve->class.pointer; } #endif /* ******************************************************************************** * INTERNAL ROUTINES ******************************************************************************** * ZPro_CurveValue(pointer, x) * * This internal routine evaluates the curve. It serves as the standard * "evalfunc" for the parent function object. * * Inputs: * pointer pointer to the ZPRO_CURVE structure. * x location at which to evaluate the curve. * * Returns: value of curve at x. *******************************************************************************/ static RL_FLT8 ZPro_CurveValue(pointer, x) RL_VOID *pointer; RL_FLT8 x; { ZPRO_CURVE *curve; RL_FLT8 value; curve = (ZPRO_CURVE *) pointer; value = (curve->evalfunc)(curve->class.pointer, x, NULL); return value; } /* ******************************************************************************** * ZPro_FreeCurve(pointer) * * This internal routine deallocates the memory used by a curve object. It * serves as the standard "freefunc" for the parent function object. * * Input: * pointer pointer to the ZPRO_CURVE structure. *******************************************************************************/ static void ZPro_FreeCurve(pointer) RL_VOID *pointer; { ZPRO_CURVE *curve; curve = (ZPRO_CURVE *) pointer; (curve->freefunc)(curve->class.pointer); XRL_Free(curve->segments); XRL_Free(curve); } /* ******************************************************************************** * ZPro_PrintCurve(pointer) * * This internal routine prints information about a curve object. It serves as * the standard "printfunc" for the parent function object. * * Input: * pointer pointer to the ZPRO_CURVE structure. *******************************************************************************/ static void ZPro_PrintCurve(pointer) RL_VOID *pointer; { ZPRO_CURVE *curve; RL_INT4 i; RL_CHAR *type; curve = (ZPRO_CURVE *) pointer; /* Make sure object is not NULL */ if (curve == NULL) { printf("PRINT ERROR: Curve pointer is NULL\n"); return; } /* Make sure object is a curve function */ if (curve->class.id != XPRO_CURVE_CLASS) { printf("PRINT ERROR: Object is not a curve\n"); return; } /* Print object info... */ printf("\nCurve parameters...\n"); for (i = 0; i <= curve->nsegments; i++) { if (curve->segments[i].type < 0) type = "minimum"; else if (curve->segments[i].type > 0) type = "maximum"; else type = "inflection"; printf("segment #%1d: (% #g, % #g) %s\n", i, curve->segments[i].x, curve->segments[i].y, type); } (curve->printfunc)(curve->class.pointer); return; } /* ******************************************************************************** * ZPro_GetCurve(object) * * This internal routine confirms that the given object is a curve and returns * a pointer to the ZPRO_CURVE data structure. * * Input: * object curve object. * * Errors: * PRO_CLASS_ERROR if object is NULL or is not a curve. *******************************************************************************/ #ifndef QUICK /* In QUICK mode, this is defined as a macro above */ static ZPRO_CURVE *ZPro_GetCurve(object) PRO_OBJECT *object; { ZPRO_CURVE *curve; /* Find curve object pointer */ curve = (ZPRO_CURVE *) XPro_FuncPtr(object); if (curve == NULL) return NULL; /* Make sure curve is not NULL */ if (curve == NULL) { XPro_NullError("curve", object); return NULL; } /* Make sure object is a curve */ if (curve->class.id != XPRO_CURVE_CLASS) { XPro_ClassError("curve", object); return NULL; } return curve; } #endif /* ******************************************************************************** * FORTRAN INTERFACE ROUTINES ******************************************************************************** *$ Component_name: * FPro_CurveValue (curve.c) *$ Abstract: * This routine returns the value and slope of a curve at a given location. *$ Keywords: * PROFILE, FUNCTION, CURVE * FORTRAN, PUBLIC, SUBROUTINE *$ Declarations: * real*8 function FPro_CurveValue(object, x, slope) * integer*4 object * real*8 x, slope *$ Inputs: * object FORTRAN pointer to the curve object. * x location at which to evaluate curve. *$ Outputs: * slope slope of curve at x. Zero is returned on a non-fatal * error. *$ Returns: * value of curve at argument. Zero is returned on a non-fatal class * error; the value at the nearest endpoint of the domain is returned on a * non-fatal domain error. *$ Detailed_description: * This routine returns the value and (optionally) slope of a curve at a * given location. A curve object extends the properties of a function * object in that it has a continuous, calculable slope. *$ External_references: * Profile toolkit *$ Side_effects: * none *$ Examples: * Suppose square is a curve that returns x squared between -3.d0 and 3.d0. * * Then FPro_CurveValue(square, 3.d0, dydx) returns 9.d0 and sets dydx to * 6.d0. *$ Error_handling: * Profile library error handling is in effect. * * Conditions raised: * PRO_CLASS_ERROR if object is NULL or is not a curve. * PRO_DOMAIN_ERROR if x-value is outside the curve's domain. * PRO_EVALUATION_FAILURE if curve could not be evaluated. * FORTRAN_POINTER_ERROR if object is not a valid FORTRAN object pointer. * * On a non-fatal PRO_DOMAIN_ERROR the value at the nearest endpoint is * returned; on other non-fatal errors, 0. is returned. In any case, the * value of the slope returned is zero. *$ 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_curvevalue) (object, x, slope) RL_INT4 *object; RL_FLT8 *x, *slope; { RL_VOID *ptr; /* Look up object pointer */ ptr = FORT_GetPointer(*object); #ifndef QUICK if (ptr == NULL) return 0.; #endif /* Call function */ return Pro_CurveValue((PRO_OBJECT *) ptr, *x, slope); } /* ******************************************************************************** *$ Component_name: * FPro_CurveInverse (curve.c) *$ Abstract: * This routine returns the inverse of the given curve. *$ Keywords: * PROFILE, FUNCTION, CURVE * FORTRAN, PUBLIC, SUBROUTINE *$ Declarations: * real*8 function FPro_CurveInverse(object, segment, y) * integer*4 object, segment * real*8 y *$ Inputs: * object FORTRAN pointer to the curve object. * segment segment number in which to search. A segment is a * monotonic section of a curve, numbered starting at 1. * y value of curve sought. *$ Outputs: * none *$ Returns: * location within the segment where the curve equals the given y-value. * An error is raised if the curve cannot be inverted; if this condition is * non-fatal, the x-value at the endpoint with the closest y-value is * returned. *$ Detailed_description: * This routine returns the inverse of the given curve, i.e. the location * within the segment where the curve equals the given y-value. * * Inverses are calculated within a specified segment, which is a monotonic * section of a curve. Segments are separated by extrema and points of * inflection, where segment #1 runs from the lower endpoint to the first * extremum/inflection point, or to the upper endpoint if that comes first. * * An error is raised if the curve cannot be inverted; if this condition * is non-fatal, the x-value at the endpoint of the segment with the * closest y-value is returned. *$ External_references: * Profile toolkit *$ Side_effects: * none *$ Examples: * Suppose square is a curve that returns x squared between -3.d0 and 3.d0. * * Then FPro_CurveInverse(square, 1, 2.25d0) returns -1.5d0; * FPro_CurveInverse(square, 2, 2.25d0) returns 1.5d0. *$ Error_handling: * Profile library error handling is in effect. * * Conditions raised: * PRO_CLASS_ERROR if object is NULL or is not a curve. * PRO_DOMAIN_ERROR if the segment index is out of range for the * curve. * PRO_EVALUATION_FAILURE if curve could not be inverted. * FORTRAN_POINTER_ERROR if object is not a valid FORTRAN object pointer. * * For a non-fatal PRO_CLASS_ERROR or FORTRAN_POINTER_ERROR, zero is * returned; for a non-fatal PRO_DOMAIN_ERROR or PRO_EVALUATION_FAILURE, * the x-value at the nearest segment endpoint is returned. *$ 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_curveinverse) (object, segment, y) RL_INT4 *object, *segment; RL_FLT8 *y; { RL_VOID *ptr; /* Look up object pointer */ ptr = FORT_GetPointer(*object); #ifndef QUICK if (ptr == NULL) return 0.; #endif /* Call function */ return Pro_CurveInverse((PRO_OBJECT *) ptr, *segment, *y); } /* ******************************************************************************** *$ Component_name: * FPro_CurveSegments (curve.c) *$ Abstract: * This function returns the number of segments in the curve domain. A * segment is the region from one endpoint, extremum, or inflection point * to the next. *$ Keywords: * PROFILE, FUNCTION, CURVE * FORTRAN, PUBLIC, SUBROUTINE *$ Declarations: * integer*4 function FPro_CurveSegments(object) * integer*4 object *$ Inputs: * object FORTRAN pointer to the curve object. *$ Outputs: * none *$ Returns: * number of segments, or 0 on error. *$ Detailed_description: * This function returns the number of segments in the curve domain. A * segment is the region from one endpoint, extremum, or inflection point * to the next. *$ External_references: * Profile toolkit *$ Side_effects: * none *$ Examples: * Suppose square is a curve that returns x squared between -3.d0 and 3.d0. * * Then FPro_CurveSegments(square) returns 2. *$ Error_handling: * Profile library error handling is in effect. On non-fatal error, the * routine returns 0. * * Conditions raised: * PRO_CLASS_ERROR if object is NULL or is not a curve. * 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_curvesegments) (object) RL_INT4 *object; { RL_VOID *ptr; /* Look up object pointer */ ptr = FORT_GetPointer(*object); if (ptr == NULL) return 0; /* Call function */ return Pro_CurveSegments((PRO_OBJECT *) ptr); } /* ******************************************************************************** *$ Component_name: * FPro_CurveExtremum (curve.c) *$ Abstract: * This routine returns the location of the given extremum, inflection * point or domain endpoint. *$ Keywords: * PROFILE, FUNCTION, CURVE * FORTRAN, PUBLIC, SUBROUTINE *$ Declarations: * real*8 function FPro_CurveExtremum(object, segment, value, type) * integer*4 object, segment, type * real*8 value *$ Inputs: * object FORTRAN pointer to the curve object. * segment segment number (0 to number of segments). *$ Outputs: * value value of the curve at this location. * type +1 if extremum is a local maximum; -1 if extremum is a * local minimum; 0 if extremum is an inflection point. *$ Returns: * location of extremum, or 0. on error. *$ Detailed_description: * This routine returns the location of the given extremum, inflection * point or domain endpoint. * * Points are identified by 0 through N, where N is the number of segments * in the curve. Here 0 and N refers to the lower and upper limits of the * domain, and 1 to N-1 refer to the local extrema and inflection points in * between. Hence, segment #n is bounded by points #n-1 and #n. *$ External_references: * Profile toolkit *$ Side_effects: * none *$ Examples: * Suppose square is a curve that returns x squared between -3.d0 and 3.d0. * * Then FPro_CurveExtremum(square, 0, value, type) returns -3.d0, sets * value to 9.d0 and sets type to +1 (maximum); * FPro_CurveExtremum(square, 1, value, type) returns 0.d0, sets * value to 0.d0 and sets type to -1 (minimum); * FPro_CurveExtremum(square, 2, value, type) returns 3.d0, sets * value to 9.d0 and sets type to +1 (maximum). *$ Error_handling: * Profile library error handling is in effect. On non-fatal error, the * routine returns 0. * * Conditions raised: * PRO_CLASS_ERROR if object is NULL or is not a curve. * PRO_DOMAIN_ERROR if the segment index is out of range for the * curve; in this case properties of the nearest * domain endpoint are returned. * 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_FLT8 FORTRAN_NAME(fpro_curveextremum) (object, segment, value, type) RL_INT4 *object, *segment, *type; RL_FLT8 *value; { RL_VOID *ptr; /* Look up object pointer */ ptr = FORT_GetPointer(*object); if (ptr == NULL) return 0.; /* Call function */ return Pro_CurveExtremum((PRO_OBJECT *) ptr, *segment, value, type); } /*******************************************************************************