SpiceInt lstltc_c ( ConstSpiceChar * string,
SpiceInt n,
SpiceInt lenvals,
const void * array )
/*
-Brief_I/O
VARIABLE I/O DESCRIPTION
-------- --- --------------------------------------------------
string I Upper bound value to search against.
n I Number elements in array.
lenvals I String length.
array I Array of possible lower bounds.
The function returns the index of the last element of array that
is lexically less than string.
-Detailed_Input
string is a string acting as an upper bound: the array element
that is lexically the greatest element less than string
is to be found. Trailing blanks in this bound value are
not significant.
n is the dimension of the array.
lenvals is the declared length of the strings in the input
string array, including null terminators. The input
array should be declared with dimension
[n][lenvals]
array is the array of character strings to be searched.
Trailing blanks in the strings in this array are not
significant. The strings must be sorted in
non-decreasing order. The elements of array need not be
distinct.
-Detailed_Output
The function returns the index of the highest-indexed element in the
input array that is lexically less than string. The routine assumes
the array elements are sorted in non-decreasing order.
If all elements of the input array are greater than or equal to the
specified upper bound string, the function returns -1.
-Parameters
None.
-Exceptions
1) If ndim < 1 the function value is -1. This is not considered
an error.
2) If input key value pointer is null, the error SPICE(NULLPOINTER) will
be signaled. The function returns -1.
3) The input key value may have length zero. This case is not
considered an error.
4) If the input array pointer is null, the error SPICE(NULLPOINTER) will
be signaled. The function returns -1.
5) If the input array string's length is less than 2, the error
SPICE(STRINGTOOSHORT) will be signaled. The function returns -1.
-Files
None.
-Particulars
Note: If you need to find the first element of the array that
is greater than or equal to string, simply add 1 to the
result returned by this function and check to see if the
result is within the array bounds given by n.
-Examples
Let array be a character array of dimension
[5][lenvals]
which contains the following elements:
"BOHR"
"EINSTEIN"
"FEYNMAN"
"GALILEO"
"NEWTON"
Then
lstltc_c ( "NEWTON", 5, lenvals, array ) == 3
lstltc_c ( "EINSTEIN", 5, lenvals, array ) == 0
lstltc_c ( "GALILEO", 5, lenvals, array ) == 2
lstltc_c ( "Galileo", 5, lenvals, array ) == 3
lstltc_c ( "BETHE", 5, lenvals, array ) == -1
-Restrictions
1) The input array is assumed to be sorted in increasing order. If
this condition is not met, the results of bsrchc_c are unpredictable.
2) String comparisons performed by this routine are Fortran-style:
trailing blanks in the input array or key value are ignored.
This gives consistent behavior with CSPICE code generated by
the f2c translator, as well as with the Fortran SPICE Toolkit.
Note that this behavior is not identical to that of the ANSI
C library functions strcmp and strncmp.
-Literature_References
None.
-Author_and_Institution
N.J. Bachman (JPL)
H.A. Neilan (JPL)
W.L. Taber (JPL)
-Version
-CSPICE Version 1.1.0, 07-MAR-2009 (NJB)
This file now includes the header file f2cMang.h.
This header supports name mangling of f2c library
functions.
-CSPICE Version 1.0.0, 22-JUL-2002 (NJB) (HAN) (WLT)
-Index_Entries
last character element less_than
-&
*/
{ /* Begin lstltc_c */
/*
f2c library utility prototypes
*/
logical l_gt (char *a, char *b, ftnlen la, ftnlen lb );
logical l_le (char *a, char *b, ftnlen la, ftnlen lb );
logical l_lt (char *a, char *b, ftnlen la, ftnlen lb );
/*
Local macros
*/
#define ARRAY( i ) ( ( (SpiceChar *)array ) + (i)*lenvals )
/*
Local variables
*/
SpiceInt begin;
SpiceInt end;
SpiceInt items;
SpiceInt j;
SpiceInt keylen;
SpiceInt middle;
/*
Use discovery check-in.
Return immediately if the array dimension is non-positive.
*/
if ( n < 1 )
{
return ( -1 );
}
/*
Make sure the pointer for the key value is non-null
and that the length is adequate.
*/
CHKPTR_VAL ( CHK_DISCOVER, "lstltc_c", string, -1 );
/*
Make sure the pointer for the string array is non-null
and that the length lenvals is sufficient.
*/
CHKOSTR_VAL ( CHK_DISCOVER, "lstltc_c", array, lenvals, -1 );
/*
Return if none of the array's elements are less than the key value.
*/
keylen = strlen(string);
begin = 0;
end = n - 1;
if ( l_le( ( char * )string,
( char * )ARRAY(begin),
( ftnlen )keylen,
( ftnlen )strlen(ARRAY(begin)) ) )
{
return ( -1 );
}
/*
Return if the key string is greater than all of the array's elements.
*/
if ( l_gt( ( char * )string,
( char * )ARRAY(end),
( ftnlen )keylen,
( ftnlen )strlen(ARRAY(end)) ) )
{
return ( end );
}
/*
Do a binary search for the specified key value.
At this point, string is greater than the first element of array and
less than or equal to the last element of array.
*/
items = n;
while ( items > 2 )
{
/*
Check the middle element.
*/
j = items / 2;
middle = begin + j;
/*
Narrow the search area.
*/
if ( l_lt ( (char * ) ARRAY(middle),
(char * ) string,
(ftnlen ) strlen( ARRAY(middle) ),
(ftnlen ) keylen ) )
{
/*
The middle element is less than string.
*/
begin = middle;
}
else
{
end = middle;
}
items = end - begin + 1;
/*
At this point, string is greater than the array element at index
begin and is less than or equal to the element at index end.
*/
}
/*
The element at index begin is the winner.
*/
return ( begin );
} /* End lstltc_c */
/* $Procedure LSTLEC ( Last character element less than or equal to. ) */
integer lstlec_(char *string, integer *n, char *array, ftnlen string_len,
ftnlen array_len)
{
/* System generated locals */
integer ret_val;
/* Builtin functions */
logical l_lt(char *, char *, ftnlen, ftnlen), l_ge(char *, char *, ftnlen,
ftnlen), l_le(char *, char *, ftnlen, ftnlen);
/* Local variables */
integer j, begin, items, middle, end;
/* $ Abstract */
/* Given a character string and an ordered array of character */
/* strings, find the index of the largest array element less than */
/* or equal to the given string. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* SEARCH, ARRAY */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* STRING I Value to search against */
/* ARRAY I Array of possible lower bounds */
/* N I Number elements in ARRAY */
/* LSTLEC O the index of the last element of ARRAY <= STRING */
/* $ Detailed_Input */
/* STRING Character string for which one desires to find */
/* the last ARRAY element less than or equal (lexically) */
/* to string. */
/* ARRAY Ordered array of character strings. We will find the */
/* last element of the sequence that is less than or equal */
/* to STRING. */
/* N Total number of elements in ARRAY */
/* $ Detailed_Output */
/* LSTLEC Index of the last element of the ordered array */
/* {ARRAY(I) : 0 < I < N + 1} that is less than or equal */
/* to STRING. (Note that LSTLEC = I for some I in the */
/* range 1 to N unless STRING is less than all of these */
/* elements in which case LSTLEC = 0.) */
/* In the case that N is input with value less than or equal */
/* to zero, LSTLEC is returned as zero. */
/* $ Parameters */
/* None. */
/* $ Particulars */
/* An ordered array of character strings is given. */
/* Given a character string STRING, there will be a last one of */
/* these strings that is less than or equal to STRING. */
/* This routine finds the index LSTLEC such that ARRAY(LSTLEC) is */
/* that string. */
/* If STRING is not greater than ARRAY(1), LSTLEC will be set to */
/* zero. */
/* This routine uses a binary search algorithm and so requires */
/* at most LOG_2(N) steps to find the value of LSTLTI. */
/* Note: If you need to find the first element of the array that */
/* is greater than STRING, simply add 1 to the result */
/* returned by this function and check to see if the result */
/* is within the array bounds given by N. */
/* $ Examples */
/* Suppose that you have a long list of words, sorted alphabetically */
/* and entirely in upper case. Furthermore suppose you wished to */
/* find all words that begin the sequence of letters PLA, then */
/* you could execute the following code. */
/* START = 0 */
/* I = 1 */
/* DO I = 1, NWORDS */
/* IF ( WORD(I)(1:3) .EQ. 'PLA' ) THEN */
/* IF ( START .EQ. 0 ) THEN */
/* START = I */
/* END IF */
/* END = I */
/* END IF */
/* END DO */
/* This can of course be improved by stopping the loop once START */
/* is non-zero and END remains unchanged after a pass through the */
/* loop. However, this is a linear search and on average can be */
/* expected to take NWORDS/2 comparisons. The above algorithm */
/* fails to take advantage of the structure of the list of words */
/* (they are sorted). */
/* The code below is much simpler to code, simpler to check, and */
/* much faster than the code above. */
/* START = LSTLEC( 'PL ', NWORDS, WORDS ) + 1 */
/* END = LSTLEC( 'PLA', NWORDS, WORDS ) */
/* do something in case there are no such words. */
/* IF ( START .GT. END ) THEN */
/* START = 0 */
/* END = 0 */
/* END IF */
/* This code will never exceed 2 * LOG_2 ( NWORDS ) comparisons. */
/* For a large list of words (say 4096) the second method will */
/* take 24 comparisons the first method requires on average */
/* 2048 comparisons. About 200 times as much time. Its clear */
/* that if searches such as this must be performed often, that */
/* the second approach could make the difference between being */
/* able to perform the task in a few minutes as opposed to */
/* several hours. */
/* For more ideas regarding the use of this routine see LSTLEI */
/* and LSTLTI. */
/* $ Restrictions */
/* If the array is not ordered, the program will run */
/* to completion but the index found will not mean anything. */
/* $ Exceptions */
/* Error free. */
/* $ Files */
/* None. */
/* $ Author_and_Institution */
/* H.A. Neilan (JPL) */
/* W.L. Taber (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) */
/* -& */
/* $ Index_Entries */
/* last character element less_than_or_equal_to */
/* -& */
/* $ Revisions */
/* - Beta Version 1.1.0, 9-MAR-1989 (HAN) */
/* Declaration of the variable I was removed from the code. The */
/* variable was declared but not used. */
/* - Beta Version 1.0.1, 1-Feb-1989 (WLT) */
/* Example section of header upgraded. */
/* -& */
/* Local variables */
items = *n;
begin = 1;
end = *n;
if (*n <= 0) {
/* There's nobody home---that is there is nothing in the array */
/* to compare against. Zero is the only sensible thing to return. */
ret_val = 0;
} else if (l_lt(string, array + (begin - 1) * array_len, string_len,
array_len)) {
/* None of the array elements are less than or equal to STRING */
ret_val = 0;
} else if (l_ge(string, array + (end - 1) * array_len, string_len,
array_len)) {
/* STRING is greater than or equal to all elements of the array. */
/* Thus the last element of the array is the last item less than */
/* or equal to STRING. */
ret_val = end;
} else {
/* STRING lies between some pair of elements of the array */
while(items > 2) {
j = items / 2;
middle = begin + j;
if (l_le(array + (middle - 1) * array_len, string, array_len,
string_len)) {
begin = middle;
} else {
end = middle;
}
items = end - begin + 1;
}
ret_val = begin;
}
return ret_val;
} /* lstlec_ */
/* $Procedure M2ALPH ( Determine if a word starts with a letter) */
logical m2alph_(char *word, ftnlen word_len)
{
/* System generated locals */
logical ret_val;
/* Builtin functions */
logical l_le(char *, char *, ftnlen, ftnlen), l_ge(char *, char *, ftnlen,
ftnlen);
/* Local variables */
static integer i__;
extern integer ltrim_(char *, ftnlen);
/* $ Abstract */
/* This function is true if the input string begins with an */
/* alphabetic character. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* META/2 a language specification language. */
/* $ Keywords */
/* ALPHANUMERIC */
/* ASCII */
/* PARSING */
/* UTILITY */
/* WORD */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* WORD I A character string word */
/* The function is returned as .TRUE. if word is an META/2 alpha */
/* word. */
/* $ Detailed_Input */
/* WORD is a character string that is assumed to have no */
/* spaces between the first and last non-blank characters. */
/* $ Detailed_Output */
/* M2ALPH returns as .TRUE. if WORD starts with an alphabetic */
/* character. Otherwise it is returned .FALSE. */
/* $ Error_Handling */
/* None. */
/* C */
/* $ Input_Files */
/* None. */
/* $ Output_Files */
/* None. */
/* $ Particulars */
/* This is a utility routine for the subroutine META2. It */
/* determines whether or not a word is an alpha word in the sense */
/* of the language META/2. */
/* $ Examples */
/* WORD M2ALPH */
/* ------- ------ */
/* SPAM .TRUE. */
/* _SPUD .FALSE. */
/* THE_QUICK_BROWN_FOX .TRUE. */
/* THE_FIRST_TIME_EVERY_I_SAW_YOUR_FACE .TRUE. */
/* WHO?_ME? .TRUE. */
/* D!#@!@#! .TRUE. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - META/2 Configured Version 2.0.0, 9-MAY-1994 (WLT) */
/* This is the configured version of the Command Loop */
/* software as of May 9, 1994 */
/* - META/2 Configured Version 1.0.0, 3-MAY-1994 (WLT) */
/* This is the configured version of META/2 */
/* software as of May 3, 1994 */
/* Version B1.0.0, 22-MAR-1988 (WLT) (IMU) */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Make sure the string has the right length. */
i__ = ltrim_(word, word_len);
ret_val = l_le("A", word + (i__ - 1), (ftnlen)1, (ftnlen)1) && l_ge("Z",
word + (i__ - 1), (ftnlen)1, (ftnlen)1) || l_le("a", word + (i__
- 1), (ftnlen)1, (ftnlen)1) && l_ge("z", word + (i__ - 1), (
ftnlen)1, (ftnlen)1);
return ret_val;
} /* m2alph_ */
/* $Procedure M2NUMB ( Determine whether or not a word is a number ) */
logical m2numb_(char *word, ftnlen word_len)
{
/* System generated locals */
logical ret_val;
/* Builtin functions */
logical l_le(char *, char *, ftnlen, ftnlen), l_ge(char *, char *, ftnlen,
ftnlen);
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
static doublereal x;
extern integer ltrim_(char *, ftnlen);
static char error[80];
static integer start, length;
extern /* Subroutine */ int nparsd_(char *, doublereal *, char *, integer
*, ftnlen, ftnlen);
static integer pointr;
extern integer qrtrim_(char *, ftnlen);
static integer end;
/* $ Abstract */
/* This function is true if the input string is a number in the */
/* sense of META/2. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* META/2 a language specification language. */
/* $ Keywords */
/* ALPHANUMERIC */
/* ASCII */
/* PARSING */
/* UTILITY */
/* WORD */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* WORD I A character string word */
/* The function is returned as .TRUE. if word is an META/2 number. */
/* $ Detailed_Input */
/* WORD is a character string that is assumed to have no */
/* spaces between the first and last non-blank characters. */
/* $ Detailed_Output */
/* M2NUMB returns as .TRUE. if WORD is a parsable number. */
/* Otherwise it is returned .FALSE. */
/* $ Error_Handling */
/* None. */
/* C */
/* $ Input_Files */
/* None. */
/* $ Output_Files */
/* None. */
/* $ Particulars */
/* This is a utility routine for the subroutine META2. It */
/* determines whether or not a word is a number in the sense */
/* of the language META/2. */
/* $ Examples */
/* WORD M2NUMB */
/* ------- ------ */
/* SPAM .FALSE. */
/* 1 .TRUE. */
/* 0.289E19 .TRUE. */
/* 0.2728D12 .TRUE. */
/* -12.1892e-5 .TRUE. */
/* 12.E29 .TRUE. */
/* 12.E291 .FALSE. */
/* .E12 .FALSE. */
/* 1.2E.12 .FALSE. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - META/2 Configured Version 2.0.0, 9-MAY-1994 (WLT) */
/* This is the configured version of the Command Loop */
/* software as of May 9, 1994 */
/* - META/2 Configured Version 1.0.0, 3-MAY-1994 (WLT) */
/* This is the configured version of META/2 */
/* software as of May 3, 1994 */
/* Version B1.0.0, 22-MAR-1988 (WLT) (IMU) */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Make sure the string has the right length. */
start = ltrim_(word, word_len);
end = qrtrim_(word, word_len);
length = end - start + 1;
/* Rule out the goofy cases that NPARSD will allow. */
if (length == 1) {
ret_val = l_le("0", word, (ftnlen)1, word_len) && l_ge("9", word, (
ftnlen)1, word_len);
return ret_val;
}
if (length >= 2) {
if (*(unsigned char *)&word[start - 1] == 'E' || *(unsigned char *)&
word[start - 1] == 'e' || *(unsigned char *)&word[start - 1]
== 'D' || *(unsigned char *)&word[start - 1] == 'd') {
ret_val = FALSE_;
return ret_val;
}
if (s_cmp(word + (start - 1), "+E", (ftnlen)2, (ftnlen)2) == 0 ||
s_cmp(word + (start - 1), "-E", (ftnlen)2, (ftnlen)2) == 0 ||
s_cmp(word + (start - 1), "+D", (ftnlen)2, (ftnlen)2) == 0 ||
s_cmp(word + (start - 1), "-D", (ftnlen)2, (ftnlen)2) == 0 ||
s_cmp(word + (start - 1), "-e", (ftnlen)2, (ftnlen)2) == 0 ||
s_cmp(word + (start - 1), "+e", (ftnlen)2, (ftnlen)2) == 0 ||
s_cmp(word + (start - 1), "-d", (ftnlen)2, (ftnlen)2) == 0 ||
s_cmp(word + (start - 1), "+d", (ftnlen)2, (ftnlen)2) == 0 ||
s_cmp(word + (start - 1), ".E", (ftnlen)2, (ftnlen)2) == 0 ||
s_cmp(word + (start - 1), ".D", (ftnlen)2, (ftnlen)2) == 0 ||
s_cmp(word + (start - 1), ".e", (ftnlen)2, (ftnlen)2) == 0 ||
s_cmp(word + (start - 1), ".d", (ftnlen)2, (ftnlen)2) == 0) {
ret_val = FALSE_;
return ret_val;
}
}
if (length >= 3) {
if (s_cmp(word + (start - 1), "+.E", (ftnlen)3, (ftnlen)3) == 0 ||
s_cmp(word + (start - 1), "-.E", (ftnlen)3, (ftnlen)3) == 0 ||
s_cmp(word + (start - 1), "+.D", (ftnlen)3, (ftnlen)3) == 0
|| s_cmp(word + (start - 1), "-.D", (ftnlen)3, (ftnlen)3) ==
0) {
ret_val = FALSE_;
return ret_val;
}
}
/* Ok. Now just hit the word with NPARSD. */
s_copy(error, " ", (ftnlen)80, (ftnlen)1);
nparsd_(word, &x, error, &pointr, word_len, (ftnlen)80);
/* Any errors indicate we don't have a number. */
if (s_cmp(error, " ", (ftnlen)80, (ftnlen)1) != 0) {
ret_val = FALSE_;
} else {
ret_val = TRUE_;
}
return ret_val;
} /* m2numb_ */
