/* curve.c
********************************************************************************
* 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 Ring-Moon Systems Node, March 1998.
* Version 1.1: QUICK compilation mode added.
* Mark Showalter, October 1999.
*******************************************************************************/
#include <stdio.h>
#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<nextrema; i++) {
if (xextrema[i] > x1) break;
}
for (j=1; i<nextrema; i++, j++) {
if (xextrema[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);
}
/*******************************************************************************
*/