[
Date Prev][
Date Next][
Thread Prev][
Thread Next][
Date Index][
Thread Index]
Re: 20000223: FCALLSCFUN4, FCALLSCFUN8 problem in uniunits installation
- Subject: Re: 20000223: FCALLSCFUN4, FCALLSCFUN8 problem in uniunits installation
- Date: Wed, 23 Feb 2000 09:36:24 -0700
Jianfu Pan,
>Date: Tue, 22 Feb 2000 10:17:35 -0500 (EST)
>From: Jianfu Pan <address@hidden>
>Organization: NASA/GSFC
>To: address@hidden (Steve Emmerson)
>Subject: Re: 20000218: FCALLSCFUN4, FCALLSCFUN8 problem in uniunits
>installation
>Keywords: 200002181939.MAA10304
In the above message, you wrote:
> Sorry for the late response. Here are the answers to your questions:
>
> 1. A Fortran "REAL";
>
> size is 8 bytes.
> >
> > 2. A Fortran "DOUBLE PRECISION";
>
> 16 bytes.
> >
> > 3. A C "float"
>
> 8 bytes.
> >
> > 4. A C "double"
>
> 8 bytes.
Thanks.
I've enclosed a modified version of the file "lib/utlib.c" which should
solve your problem. Please replace your version with it and try to
build the package.
Please let me know if this helps.
Regards,
Steve Emmerson <http://www.unidata.ucar.edu>
--------Begin lib/utlib c
/*
* $Id: utlib.c,v 1.18 1999/09/08 16:18:53 steve Exp $
*
* Support functions for the units(3) library.
*/
/*LINTLIBRARY*/
#ifndef _XOPEN_SOURCE
# define _XOPEN_SOURCE
#endif
#ifndef _ANSI_C_SOURCE
# define _ANSI_C_SOURCE
#endif
#include <udposix.h>
#include <stddef.h> /* for ptrdiff_t */
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <errno.h>
#include <ctype.h>
#include <math.h>
#include <assert.h>
#include <search.h>
#include <math.h> /* for modf(), floor(), log10(), ceil() */
#include <limits.h> /* for *PATH_MAX */
#include <float.h> /* for DBL_DIG */
#include "cfortran.h" /* for FORTRAN support */
#include "udunits.h"
#include "utprivate.h"
/*
* cfortran.h support for unit arguments:
*/
/* C-returning-to-FORTRAN: */
#define PUNIT_cfFZ(UN,LN) utUnit* fcallsc(UN,LN)(void
/* The following might be wrong and require modification for the next
* version of cfortran.h */
#define PUNIT_cfINT(N,A,B,X,Y,Z) SIMPLE_cfINT(N,A,B,X,Y,Z)
#define PUNIT_cfUU(PUNIT,A0) utUnit* A0
#define PUNIT_cfL A0 =
#define PUNIT_cfI return A0;
#define PUNIT_cfK
/* FORTRAN-calling-C: */
#define PPUNIT_cfV( T,A,B,F) SIMPLE_cfV(T,A,B,F)
#define PPUNIT_cfSEP(T, B) SIMPLE_cfSEP(T,B)
#define PPUNIT_cfINT(N,A,B,X,Y,Z) SIMPLE_cfINT(N,A,B,X,Y,Z)
#define PPUNIT_cfSTR(N,T,A,B,C,D,E) SIMPLE_cfSTR(N,T,A,B,C,D,E)
#define PPUNIT_cfCC( T,A,B) SIMPLE_cfCC(T,A,B)
#define PPUNIT_cfAA( T,A,B) PPUNIT_cfB(T,A) /* Argument B not used. */
#define PPUNIT_cfU( T,A) PPUNIT_cfN(T,A)
#define PPUNIT_cfN( T,A) utUnit** A
#define PPUNIT_cfT(M,I,A,B,D) *A
/* Output, Fortran character buffer: */
#define CBUF_cfINT(N,A,B,X,Y,Z) STRING_cfINT(N,A,B,X,Y,Z)
#define CBUF_cfSEP(T, B) STRING_cfSEP(T,B)
#define CBUF_cfN( T,A) STRING_cfN(T,A)
#define CBUF_cfSTR(N,T,A,B,C,D,E) STRING_cfSTR(N,T,A,B,C,D,E)
#if defined(vmsFortran)
# define CBUF_cfT(M,I,A,B,D) A->dsc$a_pointer, A->dsc$w_length
#elif defined(CRAYFortran)
# define CBUF_cfT(M,I,A,B,D) _fcdtocp(A), _fcdlen(A)
#else
# define CBUF_cfT(M,I,A,B,D) A, D
#endif
#ifndef PATH_MAX
# define PATH_MAX _POSIX_PATH_MAX
#endif
#undef DUPSTR
#define DUPSTR(s) strcpy((char*)malloc(strlen(s)+1), s)
#undef ABS
#define ABS(a) ((a) < 0 ? -(a) : (a))
#undef MIN
#define MIN(a,b) ((a) < (b) ? (a) : (b))
#undef MAX
#define MAX(a,b) ((a) > (b) ? (a) : (b))
typedef struct {
char *name;
int nchr;
int HasPlural;
utUnit unit;
} UnitEntry;
typedef struct {
char *name; /* prefix string (e.g. "milli") */
UtFactor factor; /* corresponding multiplying factor */
short nchar; /* size of prefix string excluding EOS */
} PrefixEntry;
/*
* Prefix table in the order required by the prefix-entry comparison function.
* The names are Based on ANSI/IEEE Std 260-1978 (a.k.a. ANSI Y10.19-1969) --
* reaffirmed 1985. The names must be unique.
*
* NB: The short-prefix symbol corresponding to the prefix "micro" has been
* changed here from the standard one (the Greek letter "mu") to the symbol
* "u".
*/
#define PE(name, factor) {name, factor, sizeof(name)-1}
static PrefixEntry PrefixTable[] = {
PE("E", 1e18),
PE("G", 1e9),
PE("M", 1e6),
PE("P", 1e15),
PE("T", 1e12),
PE("Y", 1e24),
PE("Z", 1e21),
PE("a", 1e-18),
PE("atto", 1e-18),
PE("c", 1e-2),
PE("centi", 1e-2),
PE("d", 1e-1),
PE("da", 1e1),
PE("deca", 1e1), /* Spelling according to "ISO 2955: Information
* processing -- Representation of SI and other units
* in systems with limited character sets". */
PE("deci", 1e-1),
PE("deka", 1e1), /* Spelling according to "ASTM Designation: E 380 - 85:
* Standard for METRIC PRACTICE" and "ANSI/IEEE Std
* 260-1978 (Reaffirmed 1985): IEEE Standard Letter
* Symbols for Units of Measurement". */
PE("exa", 1e18),
PE("f", 1e-15),
PE("femto", 1e-15),
PE("giga", 1e9),
PE("h", 1e2),
PE("hecto", 1e2),
PE("k", 1e3),
PE("kilo", 1e3),
PE("m", 1e-3),
PE("mega", 1e6),
PE("micro", 1e-6),
PE("milli", 1e-3),
PE("n", 1e-9),
PE("nano", 1e-9),
PE("p", 1e-12),
PE("peta", 1e15),
PE("pico", 1e-12),
PE("tera", 1e12),
PE("u", 1e-6),
PE("y", 1e-24),
PE("yocto", 1e-24),
PE("yotta", 1e24),
PE("z", 1e-21),
PE("zepto", 1e-21),
PE("zetta", 1e21),
NULL
};
static void *root = NULL;
static int initialized = 0; /* module initialized = no */
static int NumberBaseUnits = 0; /* number of base units */
static int HaveStdTimeUnit = 0; /* standard time unit set? */
static char *input_buf; /* scanner input buffer */
static char *input_ptr; /* scanner input position */
static char *unput_ptr; /* position in unput() buffer */
static char unput_buf[512]; /* scanner unput() buffer */
static char linebuf[512]; /* input units-specification buffer */
static char BaseName[UT_MAXNUM_BASE_QUANTITIES][UT_NAMELEN];
static FILE *UtFile; /* input units-file */
static char UnitsFilePath[PATH_MAX];/* input units-file path */
static utUnit StdTimeUnit; /* standard time unit for determining
* if a unit structure refers to a unit
* of time
*/
/*
* The following two functions convert between Julian day number and
* Gregorian/Julian dates (Julian dates are used prior to October 15,
* 1582; Gregorian dates are used after that). Julian day number 0 is
* midday, January 1, 4713 BCE. The Gregorian calendar was adopted
* midday, October 15, 1582.
*
* Author: Robert Iles, March 1994
*
* C Porter: Steve Emmerson, October 1995
*
* Original: http://www.nag.co.uk:70/nagware/Examples/calendar.f90
*
* There is no warranty on this code.
*/
/*
* Convert a Julian day number to a Gregorian/Julian date.
*/
void
julday_to_gregdate(julday, year, month, day)
unsigned long julday; /* Julian day number to convert */
int *year; /* Gregorian year (out) */
int *month; /* Gregorian month (1-12) (out) */
int *day; /* Gregorian day (1-31) (out) */
{
#if INT_MAX <= 0X7FFF
long ja, jb, jd;
#else
int ja, jb, jd;
#endif
int jc;
int je, iday, imonth, iyear;
double xc;
if (julday < 2299161)
ja = julday;
else
{
int ia = ((julday - 1867216) - 0.25) / 36524.25;
ja = julday + 1 + ia - (int)(0.25 * ia);
}
jb = ja + 1524;
xc = ((jb - 2439870) - 122.1) / 365.25;
jc = 6680.0 + xc;
jd = 365 * jc + (int)(0.25 * jc);
je = (int)((jb - jd) / 30.6001);
iday = (int)(jb - jd - (int)(30.6001 * je));
imonth = je - 1;
if (imonth > 12)
imonth -= 12;
iyear = jc - 4715;
if (imonth > 2)
iyear -= 1;
if (iyear <= 0)
iyear -= 1;
*year = iyear;
*month = imonth;
*day = iday;
}
/*
* Convert a Gregorian/Julian date to a Julian day number.
*
* The Gregorian calendar was adopted midday, October 15, 1582.
*/
unsigned long
gregdate_to_julday(year, month, day)
int year; /* Gregorian year */
int month; /* Gregorian month (1-12) */
int day; /* Gregorian day (1-31) */
{
#if INT_MAX <= 0X7FFF
long igreg = 15 + 31 * (10 + (12 * 1582));
long iy; /* signed, origin 0 year */
long ja; /* Julian century */
long jm; /* Julian month */
long jy; /* Julian year */
#else
int igreg = 15 + 31 * (10 + (12 * 1582));
int iy; /* signed, origin 0 year */
int ja; /* Julian century */
int jm; /* Julian month */
int jy; /* Julian year */
#endif
unsigned long julday; /* returned Julian day number */
/*
* Because there is no 0 BC or 0 AD, assume the user wants the start of
* the common era if they specify year 0.
*/
if (year == 0)
year = 1;
iy = year;
if (year < 0)
iy++;
if (month > 2)
{
jy = iy;
jm = month + 1;
}
else
{
jy = iy - 1;
jm = month + 13;
}
/*
* Note: SLIGHTLY STRANGE CONSTRUCTIONS REQUIRED TO AVOID PROBLEMS WITH
* OPTIMISATION OR GENERAL ERRORS UNDER VMS!
*/
julday = day + (int)(30.6001 * jm);
if (jy >= 0)
{
julday += 365 * jy;
julday += 0.25 * jy;
}
else
{
double xi = 365.25 * jy;
if ((int)xi != xi)
xi -= 1;
julday += (int)xi;
}
julday += 1720995;
if (day + (31* (month + (12 * iy))) >= igreg)
{
ja = jy/100;
julday -= ja;
julday += 2;
julday += ja/4;
}
return julday;
}
/*
* Encode a date as a double-precision value.
*/
double
utencdate(year, month, day)
int year;
int month;
int day;
{
return ((long)gregdate_to_julday(year, month, day) -
(long)gregdate_to_julday(2001, 1, 1)) * 86400.0;
}
/*
* Encode a time as a double-precision value.
*/
double
utencclock(hours, minutes, seconds)
int hours;
int minutes;
double seconds;
{
return (hours*60 + minutes)*60 + seconds;
}
/*
* Decompose a value into a set of values accounting for uncertainty.
*/
static void
decomp(value, uncer, nbasis, basis, count)
double value;
double uncer; /* >= 0 */
int nbasis;
double *basis; /* all values > 0 */
double *count;
{
int i;
for (i = 0; i < nbasis; i++)
{
double r = fmod(value, basis[i]); /* remainder */
/* Adjust remainder to minimum magnitude. */
if (ABS(2*r) > basis[i])
r += r > 0
? -basis[i]
: basis[i];
if (ABS(r) <= uncer)
{
/* The value equals a basis multiple within the uncertainty. */
double half = value < 0 ? -basis[i]/2 : basis[i]/2;
modf((value+half)/basis[i], count+i);
break;
}
value = basis[i] * modf(value/basis[i], count+i);
}
for (i++; i < nbasis; i++)
count[i] = 0;
}
/*
* Decode a time from a double-precision value.
*/
static void
dectime(value, year, month, day, hour, minute, second)
double value;
int *year;
int *month;
int *day;
int *hour;
int *minute;
float *second;
{
long days;
long hours;
long minutes;
double seconds;
double uncer; /* uncertainty of input value */
typedef union
{
double vec[7];
struct
{
double days;
double hours12;
double hours;
double minutes10;
double minutes;
double seconds10;
double seconds;
} ind;
} Basis;
Basis counts;
static Basis basis;
basis.ind.days = 86400;
basis.ind.hours12 = 43200;
basis.ind.hours = 3600;
basis.ind.minutes10 = 600;
basis.ind.minutes = 60;
basis.ind.seconds10 = 10;
basis.ind.seconds = 1;
uncer = ldexp(value < 0 ? -value : value, -DBL_MANT_DIG);
days = floor(value/86400.0);
value -= days * 86400.0; /* make positive excess */
decomp(value, uncer, sizeof(basis.vec)/sizeof(basis.vec[0]),
basis.vec, counts.vec);
days += counts.ind.days;
hours = (int)counts.ind.hours12 * 12 + (int)counts.ind.hours;
minutes = (int)counts.ind.minutes10 * 10 + (int)counts.ind.minutes;
seconds = (int)counts.ind.seconds10 * 10 + counts.ind.seconds;
*second = seconds;
*minute = minutes;
*hour = hours;
julday_to_gregdate(gregdate_to_julday(2001, 1, 1) + days, year, month, day);
}
/*
* Indicate whether or not the given unit structure refers to a unit of time.
*
* This function returns:
* 1 unit structure is a unit of time;
* 0 unit structure is not a unit of time.
*/
int
utIsTime(up)
const utUnit *up;
{
int status;
if (!initialized || !HaveStdTimeUnit) {
status = 0;
} else {
int iquan;
for (iquan = 0; iquan < UT_MAXNUM_BASE_QUANTITIES; ++iquan)
if (up->power[iquan] != StdTimeUnit.power[iquan])
break;
status = iquan == UT_MAXNUM_BASE_QUANTITIES;
}
return status;
}
/*
* FORTRAN interface to the above function.
*/
FCALLSCFUN1(INT,utIsTime,UTTIME,uttime,
PPUNIT)
/*
* Indicate whether or not the given unit structure has an origin.
*
* This function returns:
* 1 unit structure has an origin;
* 0 unit structure doesn't have an origin.
*/
int
utHasOrigin(up)
const utUnit *up;
{
return initialized && up->hasorigin;
}
/*
* FORTRAN interface to the above function.
*/
FCALLSCFUN1(INT,utHasOrigin,UTORIGIN,utorigin,
PPUNIT)
/*
* Clear a unit structure by setting it to the dimensionless identity
* unit structure.
*
* This function returns a pointer to the unit structure.
*/
utUnit*
utClear(unit)
utUnit *unit;
{
register int iquan;
unit->hasorigin = 0;
unit->origin = 0.0;
unit->factor = 1.0;
for (iquan = 0; iquan < UT_MAXNUM_BASE_QUANTITIES; ++iquan)
unit->power[iquan] = 0;
return unit;
}
/*
* FORTRAN interface to the above function.
*/
FCALLSCSUB1(utClear,UTCLR,utclr,
PPUNIT)
/*
* Copy a unit structure.
*
* This function returns a pointer to the destination unit structure.
*/
utUnit*
utCopy(source, dest)
const utUnit *source;
utUnit *dest;
{
assert(source != NULL);
assert(dest != NULL);
*dest = *source;
return dest;
}
/*
* FORTRAN interface to the above function.
*/
FCALLSCSUB2(utCopy,UTCPY,utcpy,
PPUNIT,PPUNIT)
/*
* Set the exponent of the given base quantity to unity.
*
* This function returns:
* NULL error;
* !NULL success (points to the input unit structure).
*/
utUnit*
utSetPower(unit, position)
utUnit *unit;
int position;
{
utUnit *result = NULL;
if (position < 0 || position >= UT_MAXNUM_BASE_QUANTITIES) {
(void) fprintf(stderr,
"udunits(3): %d is an invalid quantity index. Valid range is 0-%d\n",
position, UT_MAXNUM_BASE_QUANTITIES);
} else {
unit->power[position] = 1;
result = unit;
}
return result;
}
/*
* Shift the origin of a unit structure.
*
* This function returns a pointer to the destination unit structure.
*/
utUnit*
utShift(source, amount, result)
utUnit *source;
double amount;
utUnit *result;
{
assert(source != NULL);
assert(result != NULL);
(void) utCopy(source, result);
result->origin = source->origin + amount*result->factor;
result->hasorigin = 1;
return result;
}
/*
* FORTRAN interface to the above function.
*/
FCALLSCSUB3(utShift,UTORIG,utorig,
PPUNIT,DOUBLE,PPUNIT)
/*
* Scale a "unit" structure.
*
* This function returns a pointer to the destination unit structure.
*/
utUnit*
utScale(source, factor, result)
utUnit *source;
double factor;
utUnit *result;
{
assert(source != NULL);
assert(result != NULL);
(void) utCopy(source, result);
result->factor *= factor;
result->origin *= factor;
return result;
}
/*
* FORTRAN interface to the above function.
*/
FCALLSCSUB3(utScale,UTSCAL,utscal,
PPUNIT,DOUBLE,PPUNIT)
/*
* Multiply two unit-structures.
*
* This function returns
* NULL failure;
* pointer to `result' success.
*/
utUnit*
utMultiply(term1, term2, result)
utUnit *term1, *term2, *result;
{
utUnit *res = NULL;
if (term2->hasorigin && term1->hasorigin) {
(void) fprintf(stderr,
"udunits(3): Can't multiply units with origins\n");
} else {
int iquan;
result->factor = term1->factor * term2->factor;
result->origin = term1->hasorigin
? term1->origin * term2->factor
: term2->origin * term1->factor;
result->hasorigin = term1->hasorigin || term2->hasorigin;
for (iquan = 0; iquan < UT_MAXNUM_BASE_QUANTITIES; ++iquan)
result->power[iquan] = term1->power[iquan] + term2->power[iquan];
res = result;
}
return res;
}
/*
* FORTRAN interface to the above function.
*/
FCALLSCSUB3(utMultiply,UTMULT,utmult,
PPUNIT,PPUNIT,PPUNIT)
/*
* Form the reciprocal of an internal unit specification.
*
* This function returns
* NULL failure;
* pointer to `result' success.
*/
utUnit*
utInvert(source, result)
utUnit *source, *result;
{
utUnit *res = NULL;
if (source->hasorigin) {
(void) fprintf(stderr,
"udunits(3): Can't invert a unit with an origin\n");
} else {
int iquan;
result->factor = 1./source->factor;
result->origin = 0.0;
result->hasorigin = 0;
for (iquan = 0; iquan < UT_MAXNUM_BASE_QUANTITIES; ++iquan)
result->power[iquan] = -source->power[iquan];
res = result;
}
return res;
}
/*
* FORTRAN interface to the above function.
*/
FCALLSCSUB2(utInvert,UTINV,utinv,
PPUNIT,PPUNIT)
/*
* Divide two unit-structures.
*
* This function returns
* NULL failure;
* pointer to `result' success.
*/
utUnit*
utDivide(numer, denom, result)
utUnit *numer, *denom, *result;
{
utUnit *res = NULL;
if (denom->hasorigin && numer->hasorigin) {
(void) fprintf(stderr,
"udunits(3): Can't divide units with origins\n");
} else {
int iquan;
result->factor = numer->factor / denom->factor;
result->origin = numer->origin;
result->hasorigin = numer->hasorigin;
for (iquan = 0; iquan < UT_MAXNUM_BASE_QUANTITIES; ++iquan)
result->power[iquan] = numer->power[iquan] - denom->power[iquan];
res = result;
}
return res;
}
/*
* FORTRAN interface to the above function.
*/
FCALLSCSUB3(utDivide,UTDIV,utdiv,
PPUNIT,PPUNIT,PPUNIT)
/*
* Raise a unit-structure to a given power.
*
* This function returns
* NULL failure;
* pointer to `result' success.
*/
utUnit*
utRaise(source, power, result)
utUnit *source;
int power;
utUnit *result;
{
utUnit *res = NULL;
if (source->hasorigin) {
(void) fprintf(stderr,
"udunits(3): Can't exponentiate a unit with an origin\n");
} else {
int iquan;
result->factor = pow(source->factor, (double)power);
result->origin = 0.0;
result->hasorigin = 0;
for (iquan = 0; iquan < UT_MAXNUM_BASE_QUANTITIES; ++iquan)
result->power[iquan] = source->power[iquan] * power;
res = result;
}
return res;
}
/*
* FORTRAN interface to the above function.
*/
FCALLSCSUB3(utRaise,UTEXP,utexp,
PPUNIT,INT,PPUNIT)
/*
* Open a units-file.
*
* This function returns:
* 0 success
* UT_ENOFILE couldn't open file
*/
static int
OpenUnits(filename)
char *filename;
{
int status; /* return status */
if ((UtFile = fopen(filename, "r")) == NULL) {
(void) fprintf(stderr,
"udunits(3): Couldn't open units database \"%s\": ",
filename);
perror("");
status = UT_ENOFILE;
} else {
UtLineno = 0;
linebuf[sizeof(linebuf)-1] = 0;
status = 0;
}
return status;
}
/*
* Close a units file.
*
* This function returns void.
*/
static void
CloseUnits()
{
if (UtFile != NULL) {
(void)fclose(UtFile);
UtFile = NULL;
}
}
/*
* Decode a unit specification.
*
* This function returns:
* 0 success
* UT_ESYNTAX syntax error
* UT_EUNKNOWN unknown specification
*/
static int
DecodeUnit(spec, unit)
char *spec;
utUnit *unit;
{
char specbuf[512];
/* Remove leading whitespace */
while (isspace(*spec))
++spec;
(void) strncpy(specbuf, spec, sizeof(specbuf));
specbuf[sizeof(specbuf)-1] = 0;
/* Remove trailing whitespace */
{
char *cp;
for (cp = specbuf + strlen(specbuf);
cp > specbuf && isspace(cp[-1]);
--cp)
; /* EMPTY */
*cp = 0;
}
input_ptr = input_buf = specbuf;
unput_ptr = unput_buf;
(void)utClear(FinalUnit = unit);
UnitNotFound = 0;
utrestart((FILE*)0);
return utparse() == 0 ? 0 : UnitNotFound ? UT_EUNKNOWN : UT_ESYNTAX;
}
/*
* Scan (decode) the next entry in the units file.
* If the specification is for a base unit, then the returned unit-structure
* is cleared except that the value of the next available exponent slot is
* set to one. A base unit is the unit for a fundamental (base) physical
* quantity (e.g. the unit `meter' for the base physical quantity `length').
*
* This function returns:
* 0 success
* UT_EOF end-of-file encountered
* UT_EIO I/O error
* UT_ESYNTAX syntax error
* UT_EUNKNOWN unknown specification
* UT_EALLOC allocation failure
*/
static int
ScanUnit(name, sizename, unit, HasPlural)
char *name; /* name buffer */
size_t sizename; /* size of name buffer */
utUnit *unit; /* unit specification */
int *HasPlural; /* specification has a plural form? */
{
int status = 0; /* return status = success */
for (;;) {
char *cp;
static char WhiteSpace[] = " \t";
++UtLineno;
if (fgets(linebuf, (int)sizeof(linebuf), UtFile) == NULL) {
if (feof(UtFile)) {
status = UT_EOF;
} else {
(void) perror("fgets()");
status = UT_EIO;
}
break;
}
if (linebuf[strlen(linebuf)-1] != '\n') {
(void) fprintf(stderr,
"udunits(3): Input-line longer than %lu-byte buffer\n",
(unsigned long)sizeof(linebuf));
status = UT_ESYNTAX;
break;
}
/* Truncate at comment character */
if ((cp = strchr(linebuf, '#')) != NULL)
*cp = 0;
/* Trim trailing whitespace */
for (cp = linebuf + strlen(linebuf); cp > linebuf; --cp)
if (!isspace(cp[-1]))
break;
*cp = 0;
/* Find first "black" character */
cp = linebuf + strspn(linebuf, WhiteSpace);
if (*cp != 0) {
int n = strcspn(cp, WhiteSpace);
char buf[512];
assert(sizeof(buf) > strlen(linebuf));
assert((size_t)sizename > strlen(linebuf));
(void)strncpy(name, cp, n); name[n] = 0;
cp += n;
cp += strspn(cp, WhiteSpace);
n = strcspn(cp, WhiteSpace);
(void)strncpy(buf, cp, n); name[n] = 0;
if (strcmp(buf, "P") == 0) {
*HasPlural = 1;
} else if (strcmp(buf, "S") == 0) {
*HasPlural = 0;
} else {
(void) fprintf(stderr,
"udunits(3): Invalid single/plural indicator \"%s\"\n",
buf);
status = UT_ESYNTAX;
break;
}
cp += n;
cp += strspn(cp, WhiteSpace);
(void)strcpy(buf, cp);
if (buf[0] == 0) {
(void)utClear(unit);
if (utSetPower(unit, NumberBaseUnits) == NULL) {
(void) fprintf(stderr,
"udunits(3): Couldn't set base unit #%d\n",
NumberBaseUnits);
status = UT_EALLOC;
} else {
(void)strncpy(BaseName[NumberBaseUnits], name,
UT_NAMELEN-1);
++NumberBaseUnits;
}
} else {
if ((status = DecodeUnit(buf, unit)) != 0) {
(void) fprintf(stderr,
"udunits(3): Couldn't decode \"%s\" definition \"%s\"\n",
name, buf);
}
}
break;
} /* if not a layout line */
} /* input-line loop */
if (status != 0 && status != UT_EOF)
(void) fprintf(stderr, "udunits(3): Error occurred at line %d\n",
UtLineno);
return status;
}
/*
* Read and decode the entries in the units-file, adding them to the units-
* table.
*
* This function returns:
* 0 success
* UT_ENOFILE no units-file
* UT_ESYNTAX syntax error
* UT_EUNKNOWN unknown specification
* UT_EALLOC allocation failure
* UT_EIO I/O error
*/
static int
ReadUnits(path)
char *path;
{
int status; /* return status */
if ((status = OpenUnits(path)) == 0) {
for (;;) {
int HasPlural;
char name[512];
utUnit unit;
if ((status = ScanUnit(name, sizeof(name), &unit,
&HasPlural)) == UT_EOF) {
status = 0;
break;
} else if (status == 0) {
if ((status = utAdd(name, HasPlural, &unit)) != 0) {
(void) fprintf(stderr,
"udunits(3): Couldn't add \"%s\" to units-table\n",
name);
break;
}
} else {
(void) fprintf(stderr,
"udunits(3): Couldn't read units-file \"%s\"\n",
path);
break;
}
}
CloseUnits();
} /* units-file opened */
return status;
}
/*
* Initialize the units(3) package.
*
* This function returns:
* 0 success
* UT_ENOFILE no units-file
* UT_ESYNTAX syntax error in units-file
* UT_EUNKNOWN unknown specification in units-file
* UT_EIO units-file I/O error
* UT_EALLOC allocation failure
*/
int
utInit(path)
const char *path;
{
int status;
char pathbuf[PATH_MAX+1];
if (path == NULL || path[0] == 0) {
path = getenv("UDUNITS_PATH");
if (path == NULL || path[0] == 0)
path = strcpy(pathbuf, UT_DEFAULT_PATH);
}
if (initialized && strcmp(path, UnitsFilePath) == 0) {
(void) fprintf(stderr,
"udunits(3): Already initialized from file \"%s\"\n",
path);
status = 0;
} else {
utTerm();
status = ReadUnits(path);
if (status == 0) {
(void) strncpy(UnitsFilePath, path, sizeof(UnitsFilePath)-1);
initialized = 1;
if (utScan("second", &StdTimeUnit) == 0) {
int iquan;
int seen_one = 0;
for (iquan = 0; iquan < UT_MAXNUM_BASE_QUANTITIES; ++iquan) {
if (StdTimeUnit.power[iquan] != 0) {
if (seen_one)
break;
seen_one = 1;
}
}
HaveStdTimeUnit = seen_one &&
iquan == UT_MAXNUM_BASE_QUANTITIES;
}
} else {
utTerm();
}
}
/* (void) fprintf(stderr, "utInit(): returning %d\n", status); */
return status;
}
/*
* FORTRAN interface to the above function.
*/
FCALLSCFUN1(INT,utInit,UTOPEN,utopen,
STRING)
/*
* Decode a unit specification.
*
* This function returns:
* 0 success
* UT_ENOINIT the package hasn't been initialized
* UT_EUNKNOWN unknown specification
* UT_ESYNTAX syntax error
* UT_EINVALID NULL unit argument
*/
int
utScan(spec, up)
const char *spec;
utUnit *up;
{
int status; /* return status = success */
if (spec == NULL) {
status = UT_EUNKNOWN;
} else {
if (up == NULL) {
status = UT_EINVALID;
} else {
if (!initialized) {
(void) fprintf(stderr,
"udunits(3): Package hasn't been initialized\n");
status = UT_ENOINIT;
} else {
utLexReset();
status = DecodeUnit(spec, up);
}
}
}
return status;
}
/*
* FORTRAN interface to the above function.
*/
FCALLSCFUN2(INT,utScan,UTDEC,utdec,
STRING,PPUNIT)
/*
* Encode a unit-structure into a formatted unit-secification.
*
* This function returns:
* 0 success
* UT_ENOINIT the package hasn't been initialized
* UT_EINVALID the unit-structure is invalid
*
* On error, the string argument is set to the nil-pointer.
*/
int
utPrint(unit, s)
register const utUnit *unit;
char **s;
{
int status;
if (!initialized) {
(void) fprintf(stderr,
"udunits(3): Package hasn't been initialized\n");
*s = NULL;
status = UT_ENOINIT;
} else {
if (unit->factor == 0.0) {
*s = NULL;
status = UT_EINVALID;
} else {
register int iquan;
register char *buf = linebuf;
*buf = 0;
/* Print the scale factor if it's non-unity. */
if (unit->factor != 1.0) {
(void)sprintf(buf, "%.*g ", DBL_DIG, unit->factor);
buf += strlen(buf);
}
/* Append the dimensions in terms of base quanitities. */
for (iquan = 0; iquan < UT_MAXNUM_BASE_QUANTITIES; ++iquan) {
if (unit->power[iquan] != 0) {
if (unit->power[iquan] == 1) {
(void)sprintf(buf, "%s ", BaseName[iquan]);
} else {
(void)sprintf(buf, "%s%d ", BaseName[iquan],
unit->power[iquan]);
}
buf += strlen(buf);
}
}
/* Append the origin-shift if it exists. */
if (unit->hasorigin) {
if (utIsTime(unit)) {
int year, month, day;
int hours;
int minutes;
int ndigsec; /* precision of seconds in
* number of digits */
float seconds;
dectime(unit->origin, &year, &month, &day, &hours,
&minutes, &seconds);
(void)sprintf(buf-1, "s since %d-%02d-%02d %02d:%02d ",
year, month, day,
hours, minutes);
buf += strlen(buf);
ndigsec = DBL_DIG -
(int) ceil(log10(ABS(unit->origin /
utencclock(0, 0, 1.0))));
ndigsec = MIN(ndigsec, DBL_DIG);
if (ndigsec > 0) {
int precision = MAX(0, ndigsec-2);
#if 0
double integral_secs;
double fractional_secs = modf(seconds, &integral_secs);
if (precision <= 0)
(void) sprintf(buf-1, ":%02d", (int)integral_secs);
else
(void) sprintf(buf-1, ":%02d.%.*f",
(int)integral_secs, precision,
fractional_secs);
#endif
(void)sprintf(buf-1, ":%0*.*f ", precision+3,
precision, seconds);
}
(void) strcat(buf, "UTC ");
} else {
(void)sprintf(buf, "@ %.*g ", DBL_DIG, unit->origin);
}
buf += strlen(buf);
}
/* Remove trailing space. */
if (buf > linebuf)
buf[-1] = 0;
*s = linebuf;
status = 0;
} /* unit-structure is valid */
} /* package is initialized */
return status;
}
/*
* FORTRAN helper function for the above.
*/
static int
utPrint_help(unit, buf, size)
utUnit *unit;
char *buf;
size_t size;
{
char *s;
int status = utPrint(unit, &s);
if (status == 0)
{
size_t len = strlen(s);
if (len <= size)
{
(void) memcpy(buf, s, len);
(void) memset(buf+len, ' ', size-len);
}
else
{
(void) memcpy(buf, s, size);
status = UT_ENOROOM;
}
}
return status;
}
/*
* FORTRAN interface to the above functionality.
*/
FCALLSCFUN2(INT,utPrint_help,UTENC,utenc,
PPUNIT,CBUF)
/*
* Compare two strings.
*
* This routine is used instead of strncmp(3) in order to obtain greater
* control over the returned value.
*
* This function returns the index of the first, non-matching character or
* the length of the strings if all characters match.
*/
static ptrdiff_t
mystrcmp(s1, s2)
register char *s1, *s2;
{
register char *start = s1;
for (; *s1 != 0 && *s2 != 0 && *s1 == *s2; ++s1, ++s2)
continue;
return s1 - start;
}
/*
* Compare two nodes in the units-table by comparing their names.
*
* This function returns:
* <0 first argument less than second
* =0 first and second arguments are equal
* >0 first argument greater than second
*/
static int
CompareNodes(node1, node2)
const void *node1;
const void *node2;
{
/*
* The following 2 lines might cause lint(1) to emit warnings about
* "possible pointer alignment". Thse may safely be ignored.
*/
register char *name1 = ((UnitEntry*)node1)->name;
register char *name2 = ((UnitEntry*)node2)->name;
register int status = name1[0] - name2[0]; /* quick comparison */
if (status == 0) {
/*
* Quick comparison failed. Perform a long comparison.
*/
status = mystrcmp(name1, name2);
status = name1[status] - name2[status];
}
return status;
}
/*
* Compare a target and a node in the units-table by comparing their names.
* Allow the target name to be the plural of the node name if appropriate.
*
* This function returns:
* <0 first argument less than second
* =0 first and second arguments are equal
* >0 first argument greater than second
*/
static int
FindNodes(node1, node2)
const void *node1;
const void *node2;
{
/*
* The following 2 lines might cause lint(1) to emit warnings about
* "possible pointer alignment". Thse may safely be ignored.
*/
register char *name1 = ((UnitEntry*)node1)->name;
register char *name2 = ((UnitEntry*)node2)->name;
register int status = name1[0] - name2[0];
/* quick comparison */
if (status == 0) {
/*
* Quick comparison failed. Perform a long comparison.
*/
int i = mystrcmp(name1, name2);
status = name1[i] - name2[i];
if (status == 's') {
/*
* The following 2 lines might cause lint(1) to emit warnings about
* "possible pointer alignment". Thse may safely be ignored.
*/
UnitEntry *n1 = (UnitEntry*)node1;
UnitEntry *n2 = (UnitEntry*)node2;
if (n2->HasPlural && i == n2->nchr && n2->nchr+1 == n1->nchr)
status = 0;
}
}
return status;
}
/*
* Create a new node.
*
* This function returns:
* !=NULL success
* ==NULL failure
*/
static UnitEntry*
CreateNode(name, HasPlural, unit)
char *name;
int HasPlural;
utUnit *unit;
{
int nchr = strlen(name);
UnitEntry *node = NULL;
if (nchr+1 > UT_NAMELEN) {
(void) fprintf(stderr,
"udunits(3): The name \"%s\" is too long\n", name);
} else {
/*
* The following line might cause lint(1) to emit a warning about
* "possible pointer alignment". This may safely be ignored.
*/
node = (UnitEntry*)malloc(sizeof(UnitEntry));
if (node == NULL) {
(void) fprintf(stderr,
"udunits(3): Couldn't allocate new entry\n");
} else {
if ((node->name = DUPSTR(name)) == NULL) {
(void) fprintf(stderr,
"udunits(3): Couldn't duplicate name\n");
(void) free((char*)node);
} else {
node->nchr = strlen(node->name);
node->HasPlural = HasPlural;
(void) utCopy(unit, &node->unit);
}
}
}
return node;
}
/*
* Copy construct a node (C++ terminology).
*/
static UnitEntry*
CopyCtorNode(node)
const UnitEntry *node;
{
return CreateNode(node->name, node->HasPlural, &node->unit);
}
/*
* Destroy a node.
*
* This function returns void.
*/
static void
DestroyNode(node)
UnitEntry *node;
{
if (node != NULL) {
if (node->name != NULL)
/*
* The following line might cause lint(1) to emit a warning about
* "possible pointer alignment". This may safely be ignored.
*/
(void) free((char*)node->name);
(void) free((char*)node);
}
}
/*
* Assign one node to another.
*/
static void
AssignNode(to, from)
UnitEntry *to;
const UnitEntry *from;
{
DestroyNode(to);
to->name = DUPSTR(from->name);
to->nchr = from->nchr;
to->HasPlural = from->HasPlural;
to->unit = from->unit;
}
/*
* Add a unit-structure to the units-table.
*
* This function returns:
* 0 success
* UT_EALLOC memory allocation failure
*/
int
utAdd(name, HasPlural, unit)
char *name;
int HasPlural;
utUnit *unit;
{
int status = 0; /* return status = success */
UnitEntry *nodep = CreateNode(name, HasPlural, unit);
if (nodep == NULL)
status = UT_EALLOC;
else
{
UnitEntry **found = (UnitEntry**)tsearch((void*)nodep, &root,
CompareNodes);
if (found == NULL)
{
(void) fprintf(stderr,
"udunits(3): Couldn't expand units-table for unit \"%s\"\n",
name);
status = UT_EALLOC;
DestroyNode(nodep);
}
else
if (*found != nodep)
{
(void) fprintf(stderr, "udunits(3): Replacing unit \"%s\"\n", name);
DestroyNode(*found);
*found = nodep;
}
}
return status;
}
/*
* Find the entry in the units-table corresponding to a given name.
* If an entry isn't found, try again using the singular form, if
* appropriate.
*
* This function returns:
* NULL entry not found;
* !NULL entry found.
*/
static UnitEntry*
FindUnit(name)
char *name;
{
UnitEntry node;
UnitEntry **found;
node.name = (char*)name;
node.nchr = strlen(name);
/*
* The following line might cause lint(1) to emit a warning about
* "possible pointer alignment". This may safely be ignored.
*/
found = (UnitEntry**)tfind((void*)&node, &root, FindNodes);
if (found == NULL) {
/*
* Not found. If appropriate, try again with singular form.
*/
if (node.nchr > 1 && node.name[node.nchr-1] == 's') {
char buf[UT_NAMELEN];
assert(sizeof(buf) > node.nchr-1);
node.name = strncpy(buf, name, --node.nchr);
node.name[node.nchr] = 0;
found = (UnitEntry**)tfind((void*)&node, &root,
/*
* The following line might cause lint(1) to emit a warning about
* "possible pointer alignment". This may safely be ignored.
*/
FindNodes);
/*
* Ensure that a plural form is allowed.
*/
if (found != NULL && !(*found)->HasPlural)
found = NULL;
}
}
return found == NULL ? NULL : *found;
}
/*
* Find the entry in a prefix-table corresponding to a possible
* prefix. A linear-search of the prefix-table is performed.
* An attempt is made to insure that the longest, possible, matching
* entry is returned.
*
* NB: A binary-search of the table is not possible because, for example,
* the prefix-entry for the input specification "mzmeters" (where "mz" is
* a made-up prefix) would be after the entry "micro", but the prefix-entry
* corresponding to the specification "mm" (i.e. "m") lies before "micro".
* Thus, the binary-search comparison-function can't indicate which direction
* to go.
*
* This function returns:
* NULL not found
* !NULL found
*/
static PrefixEntry*
FindPrefix(spec)
char *spec;
{
PrefixEntry *found = NULL;
register PrefixEntry *entry;
for (entry = PrefixTable; entry->name != NULL; ++entry) {
register int status;
if (entry->name[0] - spec[0] < 0 ||
(status = strncmp(entry->name, spec, entry->nchar)) < 0)
continue;
if (status > 0)
break;
if (found == NULL || found->nchar < entry->nchar)
found = entry;
}
return found;
}
/*
* Return the unit-structure corresponding to a unit-specification.
*
* NB:
* It is permissible for the specification to consist solely
* of a prefix (e.g "milli").
*
* An empty specification returns a dimensionless, unity unit-structure.
*
* On failure, the output unit-structure is unmodified.
*
* This function returns:
* 0 found (the output unit-structure is set).
* UT_ENOINIT the units-table hasn't been initialized
* UT_EUNKNOWN not found
*/
int
utFind(spec, up)
char *spec;
utUnit *up;
{
int status = 0; /* return status = found */
UnitEntry *entry = NULL;
double factor = 1;
if (root == NULL) {
(void) fprintf(stderr, "udunits(3): Units-table is empty\n");
status = UT_ENOINIT;
} else {
while (*spec != 0) {
PrefixEntry *PrefixEnt;
/*
* See if the specification is an isolated unit (e.g. "meter").
* We're done if it is.
*/
if ((entry = FindUnit(spec)) != NULL)
break;
/*
* See if the specification has a multiplying prefix. If
* so, then use the prefix's dimensionless value, skip
* over the prefix characters, and rescan.
*/
if ((PrefixEnt = FindPrefix(spec)) != NULL) {
factor *= PrefixEnt->factor;
spec += strlen(PrefixEnt->name);
continue;
}
status = UT_EUNKNOWN;
break;
} /* while something to decode */
} /* units-table is initialized */
if (status == 0)
(void)utScale(entry == NULL ? utClear(up) : &entry->unit,
factor, up);
return status;
}
/*
* Compute the conversion factor between two unit-structures.
*
* This function returns:
* 0 success.
* UT_ENOINIT the units-table hasn't been initialized
* UT_EINVALID a structure is invalid
* UT_ECONVERT the structures are not convertable
*/
int
utConvert(from, to, slope, intercept)
const utUnit *from;
const utUnit *to;
double *slope, *intercept;
{
int status = 0;
if (!initialized) {
(void) fprintf(stderr,
"udunits(3): Package hasn't been initialized\n");
status = UT_ENOINIT;
} else {
if (from->factor == 0.0 || to->factor == 0.0) {
status = UT_EINVALID;
} else {
register int iquan;
for (iquan = 0; iquan < UT_MAXNUM_BASE_QUANTITIES; ++iquan)
if (from->power[iquan] != to->power[iquan]) {
status = UT_ECONVERT;
break;
}
if (status == 0) {
/*
* Allow convertions between units with origins (e.g.
* Celsius) and those without (e.g. Kelvin) by using
* the fact that those without origins have a zero
* origin value.
*/
*slope = from->factor / to->factor;
*intercept = (from->origin - to->origin) / to->factor;
}
}
} /* package is initialized */
return status;
}
static int
f_utConvert(from, to, slope, intercept)
const utUnit *from;
const utUnit *to;
DOUBLE_PRECISION *slope;
DOUBLE_PRECISION *intercept;
{
double tmpSlope;
double tmpIntercept;
int status;
status = utConvert(from, to, &tmpSlope, &tmpIntercept);
*slope = tmpSlope;
*intercept = tmpIntercept;
return status;
}
/*
* FORTRAN interface to the above functionality.
*/
FCALLSCFUN4(INT,f_utConvert,UTCVT,utcvt,
PPUNIT,PPUNIT,PDOUBLE,PDOUBLE)
/*
* Convert a Gregorian/Julian date and time into a temporal value.
*
* Returns:
* 0 success
* UT_EINVALID not a unit of time
* UT_ENOINIT the units-table hasn't been initialized
*/
int
utInvCalendar(year, month, day, hour, minute, second, unit, value)
int year;
int month;
int day;
int hour;
int minute;
double second;
utUnit *unit;
double *value;
{
int status;
if (!utIsTime(unit) || !unit->hasorigin) {
status = UT_EINVALID;
} else {
*value = (utencdate(year, month, day) +
utencclock(hour, minute, second) - unit->origin) /
unit->factor;
status = 0;
}
return status;
}
static int
f_utInvCalendar(year, month, day, hour, minute, second, unit, value)
int year;
int month;
int day;
int hour;
int minute;
double second;
utUnit *unit;
DOUBLE_PRECISION *value;
{
double tmpValue;
int status =
utInvCalendar(year, month, day, hour, minute, second, unit, &tmpValue);
*value = tmpValue;
return status;
}
/*
* FORTRAN interface to the above function.
*/
FCALLSCFUN8(INT,f_utInvCalendar,UTICALTIME,uticaltime,
INT,INT,INT,INT,
INT,FLOAT,PPUNIT,PDOUBLE)
/*
* Convert a temporal value into UTC Gregorian/Julian date and time.
*
* Returns:
* 0: success
* UT_EINVALID: not a unit of time
*/
int
utCalendar(value, unit, year, month, day, hour, minute, second)
double value;
utUnit *unit;
int *year;
int *month;
int *day;
int *hour;
int *minute;
float *second;
{
int status;
float sec;
if (!utIsTime(unit) || !unit->hasorigin) {
status = UT_EINVALID;
} else {
dectime(unit->origin + value*unit->factor, year, month, day, hour,
minute, &sec);
*second = sec;
status = 0;
}
return status;
}
/*
* FORTRAN interface to the above function.
*/
FCALLSCFUN8(INT,utCalendar,UTCALTIME,utcaltime,
DOUBLE,PPUNIT,PINT,PINT,PINT,PINT,PINT,PFLOAT)
/*
* Create a unit structure.
*/
utUnit*
utNew()
{
return utClear((utUnit*)malloc(sizeof(utUnit)));
}
/*
* FORTRAN interface to the above functionality.
*/
FCALLSCFUN0(PUNIT,utNew,UTMAKE,utmake)
/*
* Destroy a unit structure that was created by utNew().
*/
void
utDestroy(unit)
utUnit *unit;
{
if (unit != NULL)
free((voidp)unit);
}
/*
* FORTRAN interface to the above functionality.
*/
FCALLSCSUB1(utDestroy,UTFREE,utfree,
PPUNIT)
/*
* Free allocated nodes.
*/
static void
NodeDeleter(node, order, level)
const void *node;
VISIT order;
/*ARGSUSED*/
int level;
{
if (order == leaf || order == endorder)
{
UnitEntry *entry = *(UnitEntry**)node;
(void)tdelete(entry, &root, CompareNodes);
DestroyNode(entry);
}
}
/*
* Terminate use of this package.
*
* This function returns void.
*/
void
utTerm()
{
if (root != NULL) {
twalk(root, NodeDeleter);
root = NULL;
}
initialized = 0;
NumberBaseUnits = 0;
UnitsFilePath[0] = 0;
HaveStdTimeUnit = 0;
}
/*
* FORTRAN interface to the above functionality.
*/
FCALLSCSUB0(utTerm,UTCLS,utcls)
/*
* Return the next character to the scanner.
*/
int
utinput()
{
return unput_buf < unput_ptr
? *--unput_ptr
: *input_ptr == 0
? EOF
: *input_ptr++;
}
/*
* Save the given character to be returned by the next call to utinput().
*/
void
utunput(c)
int c;
{
*unput_ptr++ = c;
}
/*
* LEX "wrap-up" routine. Indicate no more input.
*/
int
utwrap()
{
return 1;
}
/*
* YACC error routine:
*/
void
uterror(s)
char *s;
{
register int i;
(void) fprintf(stderr, "udunits(3): %s:\n", s);
(void) fputs(input_buf, stderr);
(void) putc('\n', stderr);
for (i = 0; i < input_ptr - input_buf; ++i)
(void) putc(' ', stderr);
(void) fputs("^\n", stderr);
}
