/*
******************************************************************************** * inverse.c -- routines for inverse curve objects * * User routines: * Pro_InverseCurve() creates a new curve object that returns the * inverse of another curve object. * * Mark Showalter, PDS Ring-Moon Systems Node, March 1998 *******************************************************************************/ #include <math.h> #include <stdio.h> #include <string.h> #include "profile.h" #include "fortran.h" /******************** * Type definitions * ********************/ typedef struct ZPRO_INVERSE_STRUCT { XPRO_CLASS class; PRO_OBJECT *curve; RL_INT4 segment; RL_FLT8 x1, x2, y1, y2, xmin, xmax, ymin, ymax; } ZPRO_INVERSE; /******************** * Static variables * ********************/ static XPRO_CLASS inverse_class = {XPRO_INVERSE_CLASS, "inverse", NULL}; /******************************** * Internal function prototypes * ********************************/ static RL_FLT8 ZPro_EvalInverse RL_PROTO((RL_VOID *pointer, RL_FLT8 x, RL_FLT8 *slope)); static RL_FLT8 ZPro_InvertInverse RL_PROTO((RL_VOID *pointer, RL_FLT8 y, RL_FLT8 x1, RL_FLT8 x2)); static void ZPro_FreeInverse RL_PROTO((RL_VOID *pointer)); static void ZPro_PrintInverse RL_PROTO((RL_VOID *pointer)); /* ******************************************************************************** * EXPORTED USER ROUTINES ******************************************************************************** *$ Component_name: * Pro_InverseCurve (inverse.c) *$ Abstract: * This routine generates a new curve function that returns the inverse of * a given curve. *$ Keywords: * PROFILE, FUNCTION, CURVE * C, PUBLIC, SUBROUTINE *$ Declarations: * PRO_OBJECT *Pro_InverseCurve(object, segment) * PRO_OBJECT *object; * RL_INT4 segment; *$ Inputs: * object pointer to the curve object to invert. * segment index of segment to invert. *$ Outputs: * none *$ Returns: * pointer to a new inverse curve object, or NULL on non-fatal error. *$ Detailed_description: * This routine generates a new curve function that returns the inverse of * a given curve. *$ External_references: * Profile toolkit *$ Side_effects: * Memory is allocated. The new inverse curve retains a link to the old. *$ Examples: * Suppose square is a curve that returns x squared between -4. and 4. * Then Pro_InverseCurve(square, 1) returns a curve that does the * following: * 0. <= x <= 16. return -(square root of x); * x < 0. raise PRO_DOMAIN_ERROR and return 0.; * x > 16. raise PRO_DOMAIN_ERROR and return -4. *$ 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. * RL_MEMORY_ERROR on memory allocation 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_InverseCurve(object, segment) PRO_OBJECT *object; RL_INT4 segment; { PRO_OBJECT *new; ZPRO_INVERSE *inverse; RL_INT4 nsegments; /* Check curve and segment index */ nsegments = Pro_CurveSegments(object); if (nsegments < 1) return NULL; if (segment < 1 || segment > nsegments) { XPro_IDomainError("segment index", object, 1, nsegments, segment); return NULL; } /* Allocate data structure */ inverse = (ZPRO_INVERSE *) XRL_Malloc(sizeof(ZPRO_INVERSE)); if (inverse == NULL) return NULL; /* Initialize data structure */ inverse->class = inverse_class; inverse->curve = object; inverse->segment = segment; /* Locate range endpoints * xmin = x-value at segment minimum; ymin = minimum value; * xmax = x-value at segment maximum; ymax = maximum value; */ inverse->ymin = Pro_CurveExtremum(object, segment-1, &(inverse->xmin), NULL); inverse->ymax = Pro_CurveExtremum(object, segment, &(inverse->xmax), NULL); /* Locate domain end points * x1 = minimum x; y1 = func(x1) * x2 = maximum x; y2 = func(x2) */ if (inverse->xmin < inverse->xmax) { inverse->x1 = inverse->xmin; inverse->y1 = inverse->ymin; inverse->x2 = inverse->xmax; inverse->y2 = inverse->ymax; } else { inverse->x1 = inverse->xmax; inverse->y1 = inverse->ymax; inverse->x2 = inverse->xmin; inverse->y2 = inverse->ymin; } /* Create object */ new = XPro_MakeCurve(inverse->x1, inverse->x2, 0, NULL, /* no extrema */ ZPro_EvalInverse, ZPro_InvertInverse, ZPro_FreeInverse, ZPro_PrintInverse, (RL_VOID *) inverse); /* Enslave original curve and check for errors */ if (new != NULL && XPro_EnslaveObject(new, object)) { Pro_FreeObject(new); new = NULL; } /* Transfer coordinate names to new inverse curve */ Pro_RenameObject(new, 1, Pro_ObjectName(object,2)); Pro_RenameObject(new, 2, Pro_ObjectName(object,1)); return new; } /* ******************************************************************************** * INTERNAL ROUTINES ******************************************************************************** * ZPro_EvalInverse(pointer, x, slope) * * This internal routine calculates the value of an inverse curve. * * Inputs: * pointer pointer to the ZPRO_INVERSE data structure. * x location at which to evaluate inverse curve. * *slope slope of inverse curve at x. * * Return: value of inverse curve at x. * * Errors: * PRO_EVALUATION_FAILURE if curve could not be inverted. *******************************************************************************/ static RL_FLT8 ZPro_EvalInverse(pointer, x, slope) RL_VOID *pointer; RL_FLT8 x, *slope; { ZPRO_INVERSE *inverse; RL_FLT8 value, temp; inverse = (ZPRO_INVERSE *) pointer; value = Pro_CurveInverse(inverse->curve, inverse->segment, x); if (slope != NULL) { (void) Pro_CurveValue(inverse->curve, value, &temp); if (temp != 0.) *slope = 1. / temp; else if (inverse->y2 > inverse->y1) *slope = HUGE_VAL; else *slope = -HUGE_VAL; } return value; } /* ******************************************************************************** * ZPro_InvertInverse(pointer, y, x1, x2) * * This internal routine calculates the inverse of an inverse curve. * * Inputs: * pointer pointer to the ZPRO_INVERSE data structure. * y location at which to evaluate inverse curve's inverse. * x1, x2 limits on the search for the inverse. * * Return: location at which the value of the inverse curve is y. * * Errors: * PRO_EVALUATION_FAILURE if inverse value could not be found. In this * situation, the nearest endpoint is returned. *******************************************************************************/ static RL_FLT8 ZPro_InvertInverse(pointer, y, x1, x2) RL_VOID *pointer; RL_FLT8 y, x1, x2; { ZPRO_INVERSE *inverse; RL_FLT8 value, slope; inverse = (ZPRO_INVERSE *) pointer; /* Check that solution may exist */ if (y < inverse->ymin || y > inverse->ymax) { (void) sprintf(xpro_message, "function evalation failure\n\ unable to invert curve\n\ seeking f(x) = %#g where x is in [%#g,%#g]", y, x1, x2); RL_RaiseError("PRO_EVALUATION_FAILURE", xpro_message); if (y < inverse->ymin) return inverse->xmin; else return inverse->xmax; } /* Evaluate curve */ value = Pro_CurveValue(inverse->curve, y, &slope); /* Check that solution is within desired interval */ if (value < x1 || value > x2) { (void) sprintf(xpro_message, "function evaluation failure\n\ unable to invert curve\n\ seeking f(x) = %#g where x is in [%#g,%#g]", y, x1, x2); RL_RaiseError("PRO_EVALUATION_FAILURE", xpro_message); if (value < x1) return x1; else return x2; } return value; } /* ******************************************************************************** * ZPro_FreeInverse(pointer) * * This internal routine frees the memory used by a ZPRO_INVERSE structure. * * Inputs: * pointer pointer to the ZPRO_INVERSE data structure. *******************************************************************************/ static void ZPro_FreeInverse(pointer) RL_VOID *pointer; { XRL_Free((RL_VOID *) pointer); } /* ******************************************************************************** * ZPro_PrintInverse(pointer) * * This internal routine prints out information about an inverse curve. It is * called by Pro_PrintInverse() and is used mainly for debugging. * * Input: * pointer pointer to the ZPRO_INVERSE structure. *******************************************************************************/ static void ZPro_PrintInverse(pointer) RL_VOID *pointer; { ZPRO_INVERSE *inverse; inverse = (ZPRO_INVERSE *) pointer; /* Make sure object is not NULL */ if (inverse == NULL) { printf("PRINT ERROR: Inverse function pointer is NULL\n"); return; } /* Make sure object is an inverse curve */ if (inverse->class.id != XPRO_INVERSE_CLASS) { printf("PRINT ERROR: Object is not an inverse function\n"); return; } /* Print object info... */ printf("\nInverse curve parameters...\n"); printf(" curve = "); XPro_PrintInfo(inverse->curve); printf(" segment = %1d\n", inverse->segment); printf(" domain = [%#g,%#g]\n", inverse->x1, inverse->x2); printf(" range = [%#g,%#g]\n", inverse->y1, inverse->y2); } /* ******************************************************************************** *$ Component_name: * FPro_InverseCurve (inverse.c) *$ Abstract: * This routine generates a new curve function that returns the inverse of * a given curve. *$ Keywords: * PROFILE, FUNCTION, CURVE * C, PUBLIC, SUBROUTINE *$ Declarations: * integer*4 function FPro_InverseCurve(object, segment) * integer*4 object, segment *$ Inputs: * object FORTRAN pointer to curve to invert. * segment index of segment to invert. *$ Outputs: * none *$ Returns: * FORTRAN pointer to a new curve object, or 0 on non-fatal error. *$ Detailed_description: * This routine generates a new curve function that returns the inverse of * a given curve. *$ External_references: * Profile toolkit *$ Side_effects: * Memory is allocated. The new inverse curve retains a link to the old. *$ Examples: * Suppose square is a curve that returns x squared between -4.d0 and 4.d0. * Then FPro_InverseCurve(square, 1) returns a curve that does the * following: * 0.d0 <= x <= 16.d0 return -(square root of x); * x < 0.d0 raise PRO_DOMAIN_ERROR and return 0.d0; * x > 16.d0 raise PRO_DOMAIN_ERROR and return -4.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 the segment index is out of range. * RL_MEMORY_ERROR on memory allocation error. 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_inversecurve) (object, segment) RL_INT4 *object, *segment; { RL_VOID *ptr1, *ptr2; RL_INT4 index; /* Look up curve pointer */ ptr1 = FORT_GetPointer(*object); if (ptr1 == NULL) return 0; /* Call function */ ptr2 = (RL_VOID *) Pro_InverseCurve((PRO_OBJECT *) ptr1, *segment); if (ptr2 == NULL) return 0; /* Save new pointer */ index = FORT_AddPointer(ptr2); if (index == 0) Pro_FreeObject((PRO_OBJECT *) ptr2); return index; } /********************************************************************************/