/* boxcar.c
********************************************************************************
* boxcar.c -- Boxcar function objects
*
* User routines:
* Pro_BoxcarFunc() creates a boxcar function object.
* Pro_BoxcarInfo() returns information about a boxcar function.
*
* Mark Showalter, PDS Ring-Moon Systems Node, March 1998
*******************************************************************************/
#include "stdio.h"
#include "profile.h"
#include "fortran.h"
/********************
* Type definitions *
********************/
typedef struct ZPRO_BOXCAR_STRUCT {
RL_INT4 flag;
RL_FLT8 height, halfwidth;
} ZPRO_BOXCAR;
/**********************
* Symbol definitions *
**********************/
#define ZPRO_BOXCAR_FLAG 'boxc'
/************************************
* Prototypes of internal functions *
************************************/
static RL_FLT8 ZPro_BoxcarCalc RL_PROTO((RL_FLT8 x, RL_VOID *params));
static void ZPro_PrintBoxcar RL_PROTO((RL_VOID *params));
/*
********************************************************************************
* EXPORTED USER ROUTINES
********************************************************************************
*$ Component_name:
* Pro_BoxcarFunc (boxcar.c)
*$ Abstract:
* This routine creates and returns a boxcar function object. A boxcar
* function returns a constant value inside its domain but zero at the end
* points.
*$ Keywords:
* PROFILE, FUNCTION, PSF
* C, PUBLIC, SUBROUTINE
*$ Declarations:
* PRO_OBJECT *Pro_BoxcarFunc(height, halfwidth)
* RL_FLT8 height, halfwidth;
*$ Inputs:
* height y-value of function.
* halfwidth x-value above which y-value is zero.
*$ Outputs:
* none
*$ Returns:
* pointer to a new boxcar function object, or NULL on non-fatal error.
*$ Detailed_description:
* This routine creates and returns a boxcar function object. A boxcar
* function returns a constant value inside its domain but zero at the end
* points. The x and y coordinates are initially unnamed.
*$ External_references:
* Profile toolkit
*$ Side_effects:
* Memory is allocated.
*$ Examples:
* This line of code creates a boxcar function of width 2 and height 0.5.
*
* boxcar = Pro_BoxcarFunc(0.5, 1.);
*$ Error_handling:
* Profile toolkit error handling is in effect.
*
* Conditions raised:
* 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_BoxcarFunc(height, halfwidth)
RL_FLT8 height, halfwidth;
{
ZPRO_BOXCAR *params;
PRO_OBJECT *func;
RL_INT4 paramsize;
paramsize = sizeof(ZPRO_BOXCAR);
params = (ZPRO_BOXCAR *) XRL_Malloc(paramsize);
if (params == NULL) return NULL;
params->flag = ZPRO_BOXCAR_FLAG;
params->height = height;
params->halfwidth = halfwidth;
func = Pro_SoftFunc(ZPro_BoxcarCalc, -halfwidth, halfwidth,
(RL_VOID *) params, paramsize, TRUE, ZPro_PrintBoxcar);
XRL_Free((RL_VOID *) params);
return func;
}
/*
********************************************************************************
*$ Component_name:
* Pro_BoxcarInfo (boxcar.c)
*$ Abstract:
* This routine returns information about a boxcar function object.
*$ Keywords:
* PROFILE, FUNCTION, PSF
* C, PUBLIC, SUBROUTINE
*$ Declarations:
* RL_BOOL Pro_BoxcarInfo(boxcar, height, halfwidth)
* PRO_OBJECT *boxcar;
* RL_FLT8 *height, *halfwidth;
*$ Inputs:
* boxcar pointer to a boxcar function object.
*$ Outputs:
* *height height of boxcar function.
* *halfwidth x-value above which y-value is zero.
*$ Returns:
* TRUE if this is a boxcar function; FALSE otherwise.
*$ Detailed_description:
* This routine returns information about a boxcar function object.
*$ External_references:
* Profile toolkit
*$ Side_effects:
* none
*$ Examples:
* This snippet of code of code prints the full width of a boxcar function.
*
* PRO_OBJECT *boxcar;
* RL_FLT8 halfwidth;
*
* Pro_BoxcarInfo(boxcar, NULL, &halfwidth);
* printf("Full width = %g\n", 2.*halfwidth);
*$ Error_handling:
* Profile toolkit error handling is in effect.
*
* Conditions raised:
* PRO_CLASS_ERROR if this is not a software function object.
*$ Limitations:
* none
*$ Author_and_institution:
* Mark R. Showalter
* NASA/Ames Research Center
*$ Version_and_date:
* 1.0: March 1998
*$ Change_history:
* none
*******************************************************************************/
RL_BOOL Pro_BoxcarInfo(boxcar, height, halfwidth)
PRO_OBJECT *boxcar;
RL_FLT8 *height, *halfwidth;
{
ZPRO_BOXCAR *params;
params = (ZPRO_BOXCAR *) XPro_SoftParams(boxcar);
if (params == NULL) return FALSE;
if (params->flag != ZPRO_BOXCAR_FLAG) return FALSE;
if (height != NULL) *height = params->height;
if (halfwidth != NULL) *halfwidth = params->halfwidth;
return TRUE;
}
/*
********************************************************************************
* INTERNAL ROUTINES
********************************************************************************
* ZPro_BoxcarCalc(x, params)
*
* This internal routine calculates the value of a boxcar function.
*
* Inputs:
* x location at which to evaluate function.
* params pointer to the ZPRO_BOXCAR data structure.
*
* Return: value of function at x.
*******************************************************************************/
static RL_FLT8 ZPro_BoxcarCalc(x, params)
RL_FLT8 x;
RL_VOID *params;
{
ZPRO_BOXCAR *boxpar;
boxpar = (ZPRO_BOXCAR *) params;
if (x < 0.) x = -x;
if (x == boxpar->halfwidth) return 0.;
return boxpar->height;
}
/*
********************************************************************************
* ZPro_PrintBoxcar(params)
*
* This internal routine prints information about a boxcar function.
*
* Inputs:
* params pointer to the ZPRO_BOXCAR data structure.
*******************************************************************************/
static void ZPro_PrintBoxcar(params)
RL_VOID *params;
{
ZPRO_BOXCAR *boxpar;
boxpar = (ZPRO_BOXCAR *) params;
/* Print boxcar object info... */
printf("\nBoxcar software function parameters...\n");
printf(" height = %#g\n", boxpar->height);
printf("halfwidth = %#g\n", boxpar->halfwidth);
}
/*
********************************************************************************
* FORTRAN INTERFACE ROUTINES
********************************************************************************
*$ Component_name:
* FPro_BoxcarFunc (boxcar.c)
*$ Abstract:
* This routine creates and returns a boxcar function object. A boxcar
* function returns a constant value inside its domain but zero at the
* end points.
*$ Keywords:
* PROFILE, FUNCTION, PSF
* FORTRAN, PUBLIC, SUBROUTINE
*$ Declarations:
* integer*4 function FPro_BoxcarFunc(height, halfwidth)
* real*8 height, domain
*$ Inputs:
* height y-value of function.
* halfwidth x-value above which y-value is zero.
*$ Outputs:
* none
*$ Returns:
* FORTRAN pointer to a new boxcar function, or 0 on non-fatal error.
*$ Detailed_description:
* This routine creates and returns a boxcar function object. A boxcar
* function returns a constant value inside its domain but zero at the end
* points. The x and y coordinates are initially unnamed.
*$ External_references:
* Profile toolkit
*$ Side_effects:
* Memory is allocated.
*$ Examples:
* This line of code creates a boxcar function of width 2 and height 0.5.
*
* boxcar = FPro_BoxcarFunc(0.5d0, 1.d0)
*$ Error_handling:
* Profile toolkit error handling is in effect.
*
* Conditions raised:
* 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
*******************************************************************************/
RL_INT4 FORTRAN_NAME(fpro_boxcarfunc) (height, halfwidth)
RL_FLT8 *height, *halfwidth;
{
RL_VOID *ptr;
RL_INT4 index;
ptr = (RL_VOID *) Pro_BoxcarFunc(*height, *halfwidth);
if (ptr == NULL) return 0;
index = FORT_AddPointer(ptr);
if (index == 0) Pro_FreeObject((PRO_OBJECT *) ptr);
return index;
}
/*
********************************************************************************
*$ Component_name:
* FPro_BoxcarInfo (boxcar.c)
*$ Abstract:
* This routine returns information about a boxcar function object.
*$ Keywords:
* PROFILE, FUNCTION, PSF
* FORTRAN, PUBLIC, SUBROUTINE
*$ Declarations:
* logical*4 function FPro_BoxcarInfo(boxcar, height, halfwidth)
* integer*4 boxcar
* real*8 height, halfwidth
*$ Inputs:
* boxcar FORTRAN pointer to a boxcar function object.
*$ Outputs:
* height height of boxcar function.
* halfwidth x-value above which y-value is zero.
*$ Returns:
* .TRUE. if this is a boxcar function; .FALSE. otherwise.
*$ Detailed_description:
* This routine returns information about a boxcar function object.
*$ External_references:
* Profile toolkit
*$ Side_effects:
* none
*$ Examples:
* This snippet of code of code prints the full width of a boxcar function.
*
* integer*4 boxcar
* real*8 height, halfwidth
*
* call FPro_BoxcarInfo(boxcar, height, halfwidth)
* write(*,*) "Full width = ", 2.d0*halfwidth
*$ Error_handling:
* Profile toolkit error handling is in effect.
*
* Conditions raised:
* PRO_CLASS_ERROR if this is not a software function object.
* FORTRAN_POINTER_ERROR if boxcar 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_boxcarinfo) (boxcar, height, halfwidth)
RL_INT4 *boxcar;
RL_FLT8 *height, *halfwidth;
{
RL_VOID *ptr;
RL_BOOL status;
/* Look up boxcar function pointer */
ptr = FORT_GetPointer(*boxcar);
if (ptr == NULL) return 0;
/* Return info */
status = Pro_BoxcarInfo(ptr, height, halfwidth);
return status ? FTRUE:FFALSE;
}
/*******************************************************************************
*/