/* slope.c
********************************************************************************
* slope.c -- Routines for slope function objects
*
* User routines:
* Pro_SlopeFunc() creates a new function object that returns the
* slope of a given curve.
*
* Mark Showalter, PDS Ring-Moon Systems Node, March 1998
*******************************************************************************/
#include <stdio.h>
#include "profile.h"
#include "fortran.h"
/********************
* Type definitions *
********************/
typedef struct ZPRO_SLOPEFUNC_STRUCT {
XPRO_CLASS class;
PRO_OBJECT *curve;
} ZPRO_SLOPEFUNC;
/********************
* Static variables *
********************/
static XPRO_CLASS slopefunc_class = {XPRO_SLOPEFUNC_CLASS, "slope", NULL};
/********************************
* Internal function prototypes *
********************************/
static RL_FLT8 ZPro_EvalSlope RL_PROTO((RL_VOID *pointer, RL_FLT8 x));
static void ZPro_FreeSlope RL_PROTO((RL_VOID *pointer));
static void ZPro_PrintSlope RL_PROTO((RL_VOID *pointer));
/*
********************************************************************************
* EXPORTED USER ROUTINES
********************************************************************************
*$ Component_name:
* Pro_SlopeFunc (slope.c)
*$ Abstract:
* This routine creates a function that returns the slope of a given curve.
*$ Keywords:
* PROFILE
* C, PUBLIC, SUBROUTINE
*$ Declarations:
* PRO_OBJECT *Pro_SlopeFunc(object)
* PRO_OBJECT *object;
*$ Inputs:
* object pointer to a curve object.
*$ Outputs:
* none
*$ Returns:
* pointer to a new slope function object, or NULL on non-fatal error.
*$ Detailed_description:
* This routine creates a function that returns the slope of a given curve.
* Its domain and x-coordinate name the same as that of the curve from
* which it is derived; its y-coordinate is unnamed.
*$ External_references:
* Profile toolkit
*$ Side_effects:
* Memory is allocated. The new function object retains a link to the
* original curve.
*$ Examples:
* Suppose square is a curve that returns x squared between -3. and 3.
* Then Pro_SlopeFunc(square) creates and returns a function that returns
* 2*x between -3. and 3.
*$ Error_handling:
* Profile library error handling is in effect.
*
* 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
*******************************************************************************/
PRO_OBJECT *Pro_SlopeFunc(object)
PRO_OBJECT *object;
{
PRO_OBJECT *new;
ZPRO_SLOPEFUNC *slopefunc;
RL_FLT8 x1, x2;
RL_VOID *pointer;
/* Make sure object is a curve */
pointer = XPro_CurvePtr(object);
if (pointer == NULL) return NULL;
/* Allocate and initialize structure */
slopefunc = (ZPRO_SLOPEFUNC *) XRL_Malloc(sizeof(ZPRO_SLOPEFUNC));
if (slopefunc == NULL) return NULL;
slopefunc->class = slopefunc_class;
slopefunc->curve = object;
/* Get the curve domain */
Pro_ObjectDomain(object, &x1, &x2);
/* Create function object */
new = XPro_MakeFunc(x1, x2,
ZPro_EvalSlope, ZPro_FreeSlope, ZPro_PrintSlope,
(RL_VOID *) slopefunc);
if (new != NULL && XPro_EnslaveObject(new, object)) {
Pro_FreeObject(new);
new = NULL;
}
/* Transfer X-coordinate name to new object */
Pro_RenameObject(new, 1, Pro_ObjectName(object,1));
return new;
}
/*
********************************************************************************
* INTERNAL ROUTINES
********************************************************************************
* ZPro_EvalSlope(pointer, x)
*
* This internal function serves as the "evalfunc" parameter in a function
* object derived by Pro_SlopeFunc() to return the slope of a curve object.
*
* Input:
* pointer pointer to the ZPRO_SLOPEFUNC structure.
* x location at which to evaluate the slope.
*
* Return: value of curve slope at x.
*******************************************************************************/
static RL_FLT8 ZPro_EvalSlope(pointer, x)
RL_VOID *pointer;
RL_FLT8 x;
{
ZPRO_SLOPEFUNC *slopefunc;
RL_FLT8 slope;
slopefunc = (ZPRO_SLOPEFUNC *) pointer;
(void) Pro_CurveValue(slopefunc->curve, x, &slope);
return slope;
}
/*
********************************************************************************
* ZPro_FreeSlope(pointer)
*
* This internal routine deallocates the memory used by a slope function. It
* serves as the standard "freefunc" for the parent function object.
*
* Input:
* pointer pointer to the ZPRO_SLOPEFUNC structure.
*******************************************************************************/
static void ZPro_FreeSlope(pointer)
RL_VOID *pointer;
{
XRL_Free(pointer);
}
/*
********************************************************************************
* ZPro_PrintSlope(pointer)
*
* This internal routine prints information about a slope function that has been
* derived from a curve object. It serves as the "printfunc" for the parent
* function object.
*
* Input:
* pointer pointer to the ZPRO_SLOPEFUNC structure.
*******************************************************************************/
static void ZPro_PrintSlope(pointer)
RL_VOID *pointer;
{
ZPRO_SLOPEFUNC *slopefunc;
RL_FLT8 slope;
slopefunc = (ZPRO_SLOPEFUNC *) pointer;
printf("\nSlope function derived from a curve object\n");
printf(" curve = "); XPro_PrintInfo(slopefunc->curve);
}
/*
********************************************************************************
* FORTRAN INTERFACE ROUTINES
********************************************************************************
*$ Component_name:
* FPro_SlopeFunc (slope.c)
*$ Abstract:
* This routine creates a function that returns the slope of a given curve.
*$ Keywords:
* PROFILE
* FORTRAN, PUBLIC, SUBROUTINE
*$ Declarations:
* integer*4 function FPro_SlopeFunc(object)
* integer*4 object
*$ Inputs:
* object FORTRAN pointer to a curve object.
*$ Outputs:
* none
*$ Returns:
* pointer to a new slope function object, or 0 on non-fatal error.
*$ Detailed_description:
* This routine creates a function that returns the slope of a given curve.
* Its domain and x-coordinate name the same as that of the curve from
* which it is derived; its y-coordinate is unnamed.
*$ External_references:
* Profile toolkit
*$ Side_effects:
* Memory is allocated. The new function object retains a link to the
* original curve.
*$ Examples:
* Suppose square is a curve that returns x squared between -3.d0 and 3.d0.
* Then FPro_SlopeFunc(square) creates and returns a function that returns
* 2*x between -3.d0 and 3.d0.
*$ Error_handling:
* Profile library error handling is in effect.
*
* 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_slopefunc) (object)
RL_INT4 *object;
{
RL_VOID *ptr1, *ptr2;
RL_INT4 index;
/* Look up object pointer */
ptr1 = FORT_GetPointer(*object);
if (ptr1 == NULL) return 0;
/* Call function */
ptr2 = (RL_VOID *) Pro_SlopeFunc((PRO_OBJECT *) ptr1);
if (ptr2 == NULL) return 0;
/* Save new pointer */
index = FORT_AddPointer(ptr2);
if (index == 0) Pro_FreeObject((PRO_OBJECT *) ptr2);
return index;
}
/*******************************************************************************
*/